I am trying to populate a combobox drop down list when a different combobox "combobox2" is clicked. I am receiving the error Runt time error 438 Object doesnt support this property or method. I am also sources the listfillrange values from a seperate worksheet. I have included my code below.
Private Sub ComboBox2_Click()
Dim N As Long
N = Worksheets("Regions-Offices").Cells(1, 8).End(xlDown).Row
ActiveSheet.Cells(1, 2).Value = N
Worksheets("Global").OLEObjects("ComboBox3").Object.ListFillRange = Worksheets("Regions-Offices").Range("H1:" & N).Address
End Sub
use External parameter of Address property:
Worksheets("Global").OLEObjects("ComboBox3").ListFillRange = Worksheets("Regions-Offices").Range("H1:H" & N).Address(, , , True)
The worksheet name isn't evaluated in the return of address so
"'Regions-Offices'!H1:H" & N
Related
I have an array loaded with cell addresses that are passsed into a sub that handles tab order on a sheet. I want to be able to put a control name, i.e. "MyListBox" in that array and have my function handle it. However, I cannot get it to resolve in the .activate method. If I implicitly name the control it will work but I need it to "macro expand / resolve" to the actual control name so I can say Array(x).Activate.
Here is the code I'm fumbling with to no avail. I've tried it with and without the MSFORMs declaration. I've tried concatenating the command "activesheet." & arr(x) and many other things. I'm pretty sure I'm probably missing something simple but can't seem to find it.
Sub TabIntercept()
Dim arr, a, x, nxt, sel
Dim cMyListBox As MSForms.ListBox
If TypeName(Selection) <> "Range" Then Exit Sub 'Exit if (eg) a shape is selected
Set sel = Selection.Cells(1) 'if multiple cells selected use the first...
arr = GetTabOrder(ActiveSheet.Name) 'this function loads the tab order from a table
If UBound(arr) = -1 Then
Application.OnKey "{TAB}"
Exit Sub
End If
For x = LBound(arr) To UBound(arr)
If Left(arr(x), 3) = "lst" Or Left(arr(x), 3) = "cmb" Then 'Look for a control - they all start with lst/cmb
Set cMyListBox = Sheets("Resources & Process").arr(x) 'HERE IS THE ISSUE
arr(x).Activate
End If
If sel.Address() = sel.Parent.Range(arr(x)).Address() Then
'loops back to start if at end...
nxt = IIf(x = UBound(arr), LBound(arr), x + 1)
sel.Parent.Range(arr(nxt)).Select
Exit For
End If
Next x
End Sub
Set cMyListBox = Sheets("Resources & Process").arr(x) 'HERE IS THE ISSUE
First, declare a Worksheet variable for that sheet; the Workbook.Sheets property returns an Object, so all these member calls are implicitly late-bound, and you're coding blindfolded without compiler assistance.
Dim sheet As Worksheet
Set sheet = ActiveWorkbook.Worksheets("Resources & Process")
Note the ActiveWorkbook qualifier: if you have a specific Workbook object to use instead, use that. But consider always qualifying Workbook member calls, otherwise you're implicitly referring to whatever the ActiveWorkbook is, and eventually that will not be the workbook you're expecting.
Now, sheet.arr(x) isn't going to work, as IntelliSense is now showing you when you type that . dot operator: a Worksheet object would have to expose an indexed property named arr for that to work.
What you want to do, is get the OLEObject that is named whatever the value of arr(x) is.
You get OLE objects from the Worksheet.OLEObjects property:
Dim oleControl As OLEObject
Set oleControl = sheet.OLEObjects(arr(x))
If that succeeds, you've found your MSForms control - but it's wrapped in an OLE object and we now just need to unwrap it:
Set cMyListBox = oleControl.Object
If that fails, then the MSForms control isn't compatible with the declared type of cMyListBox. But now you get IntelliSense and compile-time validation for member calls against it: if you type cMyListBox. and there's an Activate member, then the call should be valid at run-time.
Program: Excel 2016.
I have a sheet with a lot of shapes. Each of them has its own specific name and most of them are label. I want to change their caption property, but i can't find a way but calling them one by one like this:
LblLabel_1.Caption = ...
LblLabel_2.Caption = ...
LblLabel_3.Caption = ...
Instead i was looking for something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01).Caption = ...
Next
This one will result in error 438, basically saying Caption is not avaiable for this object. It still target the object, since this code:
Debug.print Shapes("LblLabel_" & BytCounter01).Name
will return me its name.
Looking for a solution:
-i've tried Controls("LblLabel_" & BytCounter01) instead of Shapes("LblLabel_" & BytCounter01) but it won't work since Controls is only for userforms, not for sheets;
-i've tried Shapes("LblLabel_" & BytCounter01).TextFrame.Characters.Text but it returns error 438 again;
-since the label is a part of a group, i've tried both
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).Caption
and
Shapes("ShpGroupOfShapes01").GroupItems(ShpShapeIndex).TextFrame.Characters.Text
but got 438 again.
Is there really no way to easily target a specific label on a sheet and change his caption?
Thank you.
EDIT: thanks to Excelosaurus, the problem is solved. Since my labels are ActiveX Controls i have to use something like this:
For BytCounter01 = 1 to 255
Shapes("LblLabel_" & BytCounter01)OLEFormat.Object.Object.Caption = ...
Next
You can check his response and comments for more details. Thanks again Excelosaurus!
To change the textual content of a shape, use .TextFrame2.TextRange.Text as shown below:
shtShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
where shtShapes is the name of your worksheet's object as seen from the Visual Basic Editor in the Project Explorer,
sShapeName is a string variable containing the name of the target shape, and
sShapeCaptionis a string variable containing the desired caption.
A code example follows. I've thrown in a function to check for a shape's existence on a worksheet, by name.
Option Explicit
Public Sub SetLabelCaptions()
Dim bCounter As Byte
Dim sShapeName As String
Dim sShapeCaption As String
For bCounter = 1 To 255
sShapeName = "LblLabel_" & CStr(bCounter)
If ShapeExists(shtMyShapes, sShapeName) Then
sShapeCaption = "Hello World " & CStr(bCounter)
shtMyShapes.Shapes(sShapeName).TextFrame2.TextRange.Text = sShapeCaption
Else
Exit For
End If
Next
End Sub
Public Function ShapeExists(ByVal pshtHost As Excel.Worksheet, ByVal psShapeName As String) As Boolean
Dim boolResult As Boolean
Dim shpTest As Excel.Shape
On Error Resume Next
Set shpTest = pshtHost.Shapes(psShapeName)
boolResult = (Not shpTest Is Nothing)
Set shpTest = Nothing
ShapeExists = boolResult
End Function
The result should look like this:
You can't assign a Caption to a Shape. (Shapes don't have Captions). One approach is to loop over the Shapes and build a little table to tell you what to loop over next:
Sub WhatDoIHave()
Dim kolumn As String, s As Shape
Dim i As Long, r As Range
kolumn = "Z"
i = 1
For Each s In ActiveSheet.Shapes
Set r = Cells(i, kolumn)
r.Value = i
r.Offset(, 1).Value = s.Name
r.Offset(, 2).Value = s.Type
r.Offset(, 3).Value = s.TopLeftCell.Address(0, 0)
i = i + 1
Next s
End Sub
Which for my sample produced:
Seeing that I have both Forms and ActiveX (OLE) Controls, I know what to loop over next. I then refer to the Control by number and assign a Caption if appropriate.
It is very simple but yet I can't figure it out. Maybe because it cannot be done? Regardless here we go:
I would like to use a combobox that will, when selected, input cells with text values, functions and reference to external cells.
First line of the options would be to have the name populated.
Second line is a formula that would change from course to course.
Third line would provide a cell with a reference to another cell's content from another file. So if multiple course file are used I can have one master file that if I change the content of a cell the change will reflect on all the course file cells that are referring to it once updated.
This is in crude code form what I would like it to perform.
Private Sub ComboBox1_Change()
If Me.ComboBox1.Value = "ITCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "ITCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>70,"Prep Week",IF(V9>65,"Week 1",IF(V9>60,"Week 2",IF(V9>55,"Week 3",IF(V9>50,"Week 4",IF(V9>45,"Week 5",IF(V9>40,"Week 6",IF(V9>35,"Week 7",IF(V9>30,"Week 8",IF(V9>25,"Week 9",IF(V9>20,"Week 10",IF(V9>15,"Week 11",IF(V9>10,"Week 12",IF(V9>5,"Week 13",IF(V9>0,"Week 14")))))))))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[ITcourse.xlsx]Sheet'!$A$3
End If
If Me.ComboBox1.Value = "HRCourse" Then
Worksheets("PARADE STATE").Range("I1").Value = "HRCourse"
Worksheets("Data Base").Range("C1").Value = IF(V9>40,"Prep Week",IF(V9>35,"Week 1",IF(V9>30,"Week 2",IF(V9>25,"Week 3",IF(V9>20,"Week 4",IF(V9>15,"Week 5",IF(V9>10,"Week 6",IF(V9>5,"Week 7",IF(V9>5,"Week 8")))))))))
Worksheets("Week 1").Range("B2").Value = 'N:\ITcourse\00 - Data Base\[HRcourse.xlsx]Sheet'!$A$3
End If
End Sub
Thank you!
You need a function that returns the number of weeks for any given course name. This function should use a Dictionary to store the information, and the dictionary may be loaded from a dedicated worksheet.
Function WeeksPerCourse(courseName As String) As Long
Static dict As Scripting.Dictionary
If dict Is Nothing Then
' Fill the dictionary here. Note that it is better
' to load the values from a dedicated, hidden worksheet
Set dict = CreateObject("Scripting.Dictionary")
dict("ITCourse") = 14
dict("HRCourse") = 8
' Etc...
End If
WeeksPerCourse = dict(courseName)
End Function
With this function available, your procedure can be simplified like follows:
Private Sub ComboBox1_Change()
Dim course As Sting: course = Trim(ComboBox1.value)
Worksheets("PARADE STATE").Range("I1").value = course
'Dim nWeek As Long
'nWeek = WeeksPerCourse(course) - Worksheets("PARADE STATE").Range("V9").value / 5
'Worksheets("Data Base").Range("C1").value = IIf(nWeek < 1, "Prep Week", "Week " & nWeek)
Worksheets("Data Base").Range("C1").Formula = "= ""Week "" & INT((WeeksPerCourse('PARADE STATE'!I1) - 'PARADE STATE'!V9)/5)"
Worksheets("Week 1").Range("B2").Formula= "='N:\ITcourse\00 - Data Base\[" & course & ".xlsx]Sheet'!$A$3"
End Sub
I'm developing an application with multiple pivot tables and slicers.
I try to prepare a template sheet and copy - paste it in order to create multiple analysis.
When I duplicate the sheet, the Slicers will be linked to both original and new pivot tables (belonging to the same SlicerCache), so I need to:
Unlink original SlicerCache from the new pivot table
Delete original Slicer from the new sheet
create new SlicerCache with the same connection settings
create new Slicer on the new sheet, belonging to the new SlicerCache
My code so far:
Function DuplicateSlicer(PreviousSlicer As Slicer) As Slicer
Dim NewSlC As SlicerCache
Dim NewSlicer As Slicer
Dim DestWorkSheet As Worksheet
Dim SlCSequence As Integer
Dim NewSlCName As String
With PreviousSlicer
Set DestWorkSheet = .Parent
.SlicerCache.PivotTables.RemovePivotTable (DestWorkSheet.PivotTables(1))
SlCSequence = 1
Do Until GetSlicerCache(DestWorkSheet.Parent, .SlicerCache.Name & SlCSequence) Is Nothing
SlCSequence = SlCSequence + 1
Loop
NewSlCName = .SlicerCache.Name & SlCSequence
Set NewSlC = DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
.SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
Set NewSlicer = NewSlC.Slicers.Add(DestWorkSheet, Caption:=.SlicerCache.SourceName, _
Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)
NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
.Delete
End With
End Function
My problem is with the line
DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
.SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
According to MSDN help it should work even without specifying name:
The name Excel uses to reference the slicer cache (the value of the
SlicerCache.Name property). If omitted, Excel will generate a name. By
default, Excel concatenates "Slicer_" with the value of the
PivotField.Caption property for slicers with non-OLAP data sources,
... (Replacing any spaces with "_".) If required to make the name
unique in the workbook namespace, Excel adds an integer to the end of
the generated name. If you specify a name that already exists in the
workbook namespace, the Add method will fail.
However even if I use my code as above, or I just omit 3rd parameter, I keep getting
error 1004: The slicer cache already exists.
To make things even more complicated, if I use a variable for name parameter of Slicercaches.Add (NewSlCName = .SlicerCache.Name & SlCSequence) I get different one:
error: 5 "Invalid procedure call or argument"
I really don't have any idea how to fix it.
Update
I've used SlicerCaches.Add2 as that's available from the object tips.
According to another article .Add is deprecated and shouldn't be used.
I've also tried .Add instead of .Add2, it gives the same error.
So far the only approach I could make to work is this:
Create two templates with the same layout and pivot tables, one of them with slicers and the other is without.
To create a new sheet: duplicate the template without slicers, then run below code for creating the slicers in the new sheet:
Sub DuplicateSlicers(NewWorkSheet As Worksheet, SourceWorkSheet As Worksheet)
Dim SlC As SlicerCache
Dim sl As Slicer
For Each SlC In SourceWorkSheet.Parent.SlicerCaches
For Each sl In SlC.Slicers
If (sl.Parent Is SourceWorkSheet) Then
Call DuplicateSlicer(sl, NewWorkSheet)
End If
Next sl
Next SlC
End Sub
Function DuplicateSlicer(PreviousSlicer As Slicer, NewSheet As Worksheet) As Slicer
Dim NewSlC As SlicerCache
Dim NewSlicer As Slicer
If PreviousSlicer Is Nothing Then
Set DuplicateSlicer = Nothing
Exit Function
End If
On Error GoTo ErrLabel
With PreviousSlicer
Set NewSlC = NewSheet.Parent.SlicerCaches.Add2(NewSheet.PivotTables(1), _
.SlicerCache.SourceName)
Set NewSlicer = NewSlC.Slicers.Add(NewSheet, Caption:=.Caption, Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With
NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
Set DuplicateSlicer = NewSlicer
Exit Function
ErrLabel:
Debug.Print PreviousSlicer.Caption & " - " & Err.Number & ": " & Err.Description
Err.Clear
End Function
I have a listbox in a Diagram, when calling the function "drawDiagram" I want to get the selected Items of the listbox. Here is my code to do that:
Function DrawDiagram()
Dim x As Integer
Dim diaLst As ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 0 To diaLst.ListCount - 1
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
diaLst.ListCount correctly returns the number of Items in the list. But diaLst.Selected(x) does not work at all.
The Error message is:
German: "Die Selected-Eigenschaft des ListBox-Objektes kann nicht zugeordent werden"
English: "The Selected Property of the ListBox Object cannot be assigned" (or similar)
Does anyone know, what I did wrong?
thanks
natasia
By the way, this is the code I used to generate the list box in a chart sheet, in a separate function. At the moment when a button is clicked, the DrawDiagram function is called. The aim of the "DrawDiagram" function is to plot the selected items of the listbox in the diagram.
Set diaLst = ActiveSheet.ListBoxes.Add(ActiveChart.ChartArea.Width - 110, 5, 105, 150)
With diaLst
.Name = "DiaList"
.PrintObject = False
.MultiSelect = xlSimple
i = 2
While wTD.Cells(rowVarNames, i) <> ""
.AddItem wTD.Cells(rowVarNames, i)
i = i + 1
Wend
.Selected(3) = True
End With
first off, you must be dealing with a "Form" control (not an "ActiveX" one) otherwise you couldn't get it via .ListBoxes property of Worksheet class
I tested it in my environment (W7-Pro and Excel 2013) and found that (quite strangely to me) the Selected() property array is 1-based.
This remained even with Option Base 0 at the beginning of the module
Make sure Microsoft Forms 2.0 Object Library reference is added to your project
Function DrawDiagram()
Dim x As Long
Dim diaLst As MSForms.ListBox
Set diaLst = ActiveSheet.ListBoxes("DiaList")
' find selected trends in List Box
For x = 1 To diaLst.ListCount
If diaLst.Selected(x) = True Then
MsgBox x
End If
Next x
End Function
use Sheets("Sheet1").Shapes("List Box 1").OLEFormat.Object instead
I stumbled upon the same problem. The solution turned out to be simple, just had to tweak the code a litte bit and play around with the ListBox properites:
Function GetSelectedRowsFromListBox(lstbox As ListBox) As Collection
Create the collection
Dim coll As New Collection
Dim lst_cnt As Variant
lst_cnt = lstbox.ListCount
Dim arr_selectedVal As Variant
arr_selectedVal = lstbox.Selected
' Read through each item in the listbox
Dim i As Long
For i = 1 To lstbox.ListCount
' Check if item at position i is selected
If arr_selectedVal(i) Then
coll.Add i
End If
Next i
Set GetSelectedRowsFromListBox = coll
End Function
.Selected property returns a 1-based array with True/False values coresponding to rows in your multiple choice Form Control ListBox.
From that you can get the list of each value.
This solution is an expanded version of what is mentioned here, however this also complies with Form Control ListBox, no just ActiveX ListBox (which are 2 same but different things ;) ):
https://excelmacromastery.com/vba-listbox/
Hope that helps in the future!