I have a collection of files that I selected in the SelectManyFiles function and I want to run multiple private subs on each Drawing in the collection function. Here's my code:
Sub Main()
Dim Drawing As Object
Dim Drawings As Collection
Set Drawings = SelectManyFiles()
For Each Drawing In Drawings
'Call multiple private subs to run on each drawing
Next Drawing
End Sub
I think there's something wrong with the loop but not sure exactly! Any help is appreciated.
The collection that's returned by SelectManyFiles is not returning a collection of objects. It's probably returning a collection of Strings, but that's just a guess. Change your sub to this
Sub Main()
Dim Drawing As Variant
Dim Drawings As Collection
Set Drawings = SelectManyFiles()
For Each Drawing In Drawings
Debug.Print TypeName(Drawing)
Next Drawing
End Sub
And see what the Debug.Print gives you. If it's any scalar (string, long, double, Boolean, etc), then you need to declare Drawing as Variant. Only if all of the collection items are objects can you use Object.
TRY
FOR X = 1 TO DRAWING.COUNT
'STUFF HAPPENS
NEXT X
Related
For part of a VBA script I'm putting together I want to iterate through all the shapes on the current slide and insert another shape on top of each.
I have a first subroutine, GetShapes(), that gets all the shapes on the current slide and then passes them by value to a second subroutine, LabelShapes(), which adds the new shapes on top.
However, the new shapes seem to show up in the Shapes object that was passed. It seems like this should not be the case as it was passed by reference.
WARNING, the below will quickly lockup PowerPoint
Sub GetShapes()
Dim ss As Shapes
Set ss = Application.ActiveWindow.View.Slide.Shapes
Call LabelShapes(ss)
End Sub
Sub LabelShapes(ByVal ss As Shapes)
Dim s As Shape
For Each s In ss
Debug.Print s.Name
Application.ActiveWindow.View.Slide.Shapes.AddShape _
Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=15, Height:=15
Next
End Sub
I imagine I can get around this by using a special naming convention for my new shapes and then filtering them out. Maybe there is a better way? But, really I would just like to understand why this isn't behaving the way I expect.
Not sure exactly what you're trying to do, but it's a common misunderstanding that passing object references ByVal would magically create a copy of the object.
Passing an object reference ByVal means you're passing a copy of the object pointer, as opposed to a reference to that very same object pointer.
In both cases, you're passing an object pointer that's pointing to the exact same object, so when you .AddShape, you're altering the very same shape collection you're in the middle of iterating.
Passing an object reference ByVal does NOT pass a copy of the object. If you want to pass a copy, you need to make a copy.
This might help clarify:
Public Sub DoSomething()
Dim obj As Object
Set obj = New Collection
TestByVal obj 'pass a copy of the object reference
Debug.Assert Not obj Is Nothing
TestByRef (obj) 'force a copy of the object reference (despite ByRef)
Debug.Assert Not obj Is Nothing
TestByRef obj 'pass a reference to the object pointer
Debug.Assert Not obj Is Nothing ' << assert will fail here
End Sub
Private Sub TestByVal(ByVal obj As Object)
Set obj = Nothing ' only affects the local copy
End Sub
Private Sub TestByRef(ByRef obj As Object)
Set obj = Nothing ' DANGER! call site will see this
End Sub
The solution is to use the ShapeRange object, which "represents a shape range, which is a set of shapes on a document."
Note from the Shapes documentation:
If you want to work with a subset of the shapes on a document — for example, to do something to only the AutoShapes on the document or to only the selected shapes — you must construct a ShapeRange collection that contains the shapes you want to work with.
Sub GetShapes()
Dim ss As ShapeRange
Set ss = Application.ActiveWindow.View.Slide.Shapes.Range
LabelShapes ss
End Sub
Sub LabelShapes(ByVal ss As ShapeRange)
Dim s As Shape
For Each s In ss
Debug.Print s.Name
Application.ActiveWindow.View.Slide.Shapes.AddShape _
Type:=msoShapeRectangle, Left:=50, Top:=50, Width:=15, Height:=15
Next
End Sub
So I have a sheet with some pictures. All of these are just a copy paste of the original picture so they all have the same name "Flower".
I want to select all of them and flip them. But it will only select the original, how do I get past this? I tried incorporating a loop as well, without luck.
Sub Test()
ActiveSheet.Shapes.Range(Array("Flower")).Select
Selection.ShapeRange.Flip msoFlipHorizontal
End Sub
I know that I could simply rename them to Flower1, Flower2 etc. but the plan is to use this for a lot of pictures, so it would take to long to change manually. If it could all be done with a loop, that would be fine, but then I would still have the same problem as above.
You can loop thru the collection Shapes looking for the shapes with the given name. Try this.
Sub Test()
Dim Pic As Shape
For Each Pic In ActiveSheet.Shapes
If Pic.Name = "Flower" Then Pic.Flip msoFlipHorizontal
Next Pic
End Sub
In addition, you can code this without selecting it. Faster and more reliable.
There are two objects in VBA that could be useful - the shape collection named Shapes and the Shape itself. Thus, you can loop through the collection like this:
Sub Test()
Dim shShape As Shape
Dim shCollection As Shapes
Set shCollection = ActiveSheet.Shapes
For Each shShape In shCollection
shShape.Flip msoFlipHorizontal
Next shShape
End Sub
I have a spin button on my worksheet (not in a userform), and I need to set the minimum and maximum values in VBA. Easy, right? I tried worksheetName.Shapes("shapeName").Min = x but I get Run-time error 438: Object doesn't support this property or method.
I used Excel's macro recorder and changed the min and max of the spin button, and it recorded the following:
ActiveSheet.Shapes("shapeName").Select
With Selection
.Min = x
.Max = y
End With
How is it that if I select the shape, I can then access its properties, but if I reference the shape directly I am unable to access the same properties? This does not make sense to me. Obviously, I would like to avoid selecting the shape and referencing "selection," as this generally is not best practice.
You can use the Shape.ControlFormat property:
Sub test()
Dim shp As Excel.Shape
Set shp = ActiveSheet.Shapes("Spinner 1")
With shp.ControlFormat
.Min = 2
.Max = 33
End With
End Sub
This answer will be helpful, although not particularly intuitive...
Excel-VBA: Getting the values from Form Controls
As I mention in the comments above, it is peculiar. The SpinButton is a member of the worksheet's Shapes collection, but it does not allow you to access those properties as a shape directly (see Doug's answer for how to do this another way which is probably better).
Try:
With ActiveSheet.Spinners("spinbutton1")
.Min = x
.Max = y
End With
Likewise, you can delcare a variable and iterate if you have multiple controls like this:
Dim spinbtn as Spinner 'or As Variant
For each spinbtn in ActiveSheet.Spinners
spinbtn.Min = x
spinbtn.Max = y
Next
Etc.
Simply you can try this:
Private Sub SpinButton1_SpinDown()
TextBox3.Text = val(TextBox3.Text) - 1
If TextBox3.Text < 0 Then TextBox3.Text = 0
End Sub
In Microsoft Visio Professional 2010 I've isolated the error I've been getting to this little code snippet. On the page is a container holding 2 shapes and I want to iterate through those shapes within another loop. But I keep getting an invalid parameter error.
My attempt at a solution is the top block, but it only works with the same definition for the inner loop. It seems like something is changing during the 2nd iteration of the outer loop, but I'm not sure. I feel it has to do with the way a For Each loop is defined.
Sub Nested_Loop_Error()
Dim a As Variant
Dim b As Variant
Dim lngs() As Long
'This Works
lngs = ActiveDocument.Pages(1).Shapes.ItemFromID(1).ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
For a = 0 To 1
For Each b In lngs
'Do nothing
Next b
Next a
'This does not work
For a = 0 To 1
For Each b In ActiveDocument.Pages(1).Shapes.ItemFromID(1).ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
MsgBox "In Loop for a=" & a
Next b
Next a
End Sub
Edit:
I've been playing around with it and got it to work, but what I'm really interested in is why it works. The 2nd block of code fails when a=1, giving an invalid parameter in the line docMyDoc.Pages...
The following is the code showing the difference of using a variant or a document variable to define the ActiveDocument within the loop. Using the debugger I can't see a difference in how docMyDoc or varMyDoc are defined.
Sub Nested_Loop_Error2()
Dim a As Variant
Dim b As Variant
Dim docMyDoc As Visio.Document
Dim varMyDoc As Variant
'This works
For a = 0 To 1
Set varMyDoc = ActiveDocument
For Each b In varMyDoc.Pages(1).Shapes.ItemFromID(1).ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
MsgBox "Using variant, a=" & a
Next b
Next a
'This does not work
For a = 0 To 1
Set docMyDoc = ActiveDocument
For Each b In docMyDoc.Pages(1).Shapes.ItemFromID(1).ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
MsgBox "Using document, a=" & a
Next b
Next a
End Sub
Using the Variant type doesn't help the compiler much: The variable called "b" should be of type Long, and the "a" variable of type Integer.
This said, you're not using the "a" variable but to repeat twice what you do in the inner loop (Msgbox), but nothing else changes.
Moreover, you need to reference the shape whose ID is b, that you're not doing.
And another tip: don't name variables after their type, but after their semantics.
I think that what you intended to do is something like the example in GetMemberShapes method's reference in MSDN:
Sub Nested_Loop()
Dim lngMemberID as Long
Dim vsoShape as Visio.Shape
Dim j as Integer
For j = 0 to 1
For Each lngMemberID In ActiveDocument.Pages(1).Shapes(1).ContainerProperties.GetMemberShapes(visContainerFlagsDefault)
Set vsoShape = ActivePage.Shapes.ItemFromID(memberID)
Debug.Print vsoShape.ID
Next lngMemberID
Next j
End Sub
Here, your vsoShape variable will refer first to one, then to the other of your shapes. And it will work even if you have more shapes in your page.
That's the good thing of Collections and the For Each loop: Collections are special objects made up as a list of other objects. They have their own methods, as Item, or Count, and shortcuts, like using a number between parenthesis to retrieve an individual object from the collection (as in Pages(1)).
What you do with For Each is to iterate through all the objects in the collection (or all the values in an array).
For your purposes, I'd try the following general structure:
dim oPage as Visio.Page
dim oShape as Visio.Shape
dim oInnerShape as Visio.Shape
For each oPage In ActiveDocument.Pages
For each oShape in oPage.Shapes
If oShape.Master.Name = "xxx" Then ' You can check the type of the shape
For each oInnerShape In oShape
' set and compute width and height
Next oInnerShape
' set and compute width and height of the containing shape
End If
Next oShape
' Rearrange shapes
Next oPage
You can construct an array storing the shape IDs, width and height, while iterating through the shapes, then use that array to rearrange the shapes.
Regards,
I don't have Visio on my computer but are you certain that the first nested loop worked?
I have doubt in lngs = ActiveDocument.Pages(1)... with Dim lngs() As Long:
Excel VBA will throw "Type mismatch" error with trying to store arr = Array(1,2) with Dim arr() As Long. Better off Dim lngs As Variant even if you know it's an array of Long being returned.
The second nested loop works in theory.
I have added a ListBox to a SHEET (not to a "UserForm")
I did this using the mouse.
I clicked the little Hammer and Wrench icon.
This ListBox seems to be easily referenced using code such as this:
ListBox1.Clear
or
ListBox1.AddItem("An option")
However, I have three of these ListBoxes (named, conveniently, ListBox1, ListBox2, and ListBox3) and I want to write a function to populate them with array data, like this:
Call populate_listbox(ListBox2, designAreaArray)
Where the first argument is the listbox name, the 2nd is the data.
But I do not know how to send "ListBox2" correctly, or refer to it correctly within the function.
For example:
Dim controlName as string
controlName = "ListBox1"
doesn't work, even if I define the function as follows:
Sub populate_listbox(LB As ListBox, dataArray As Variant)
Dim i As Integer: i = 0
For i = LBound(dataArray, 2) + 1 To UBound(dataArray, 2) ' Skip header row
LB.AddItem (dataArray(index, i))
Next i
End Sub
Clearly it results in a mis-matched data type error. I've tried defining "controlName" as a ListBox, but that didn't work either...
Though perhaps it is my reference to the listBox that is incorrect. I've seen SO MANY ways to refer to a control object...
MSForms.ListBox.
ME.ListBox
Forms.Controls.
Worksheet.Shapes.
The list goes on an on, and nothing has worked for me.
Try this:
Dim cMyListbox As MSForms.ListBox
Set cMyListbox = Sheet1.ListBox1 '// OR Worksheets("YourSheetName").Listbox1
cMyListbox.AddItem("An option")
Also you can populate a listbox without having to loop through the array, try this:
Dim cMyListbox As MSForms.ListBox
Dim vArray As Variant
Set cMyListbox = Sheet1.ListBox1
vArray = Range("A1:A6").Value
cMyListbox.List = vArray
Change the sub signature to match this:
Sub populate_listbox(LB As MSForms.ListBox, dataArray As Variant)
Now you can pass it like you were trying to originally.
NOTE: This only works if you used the "ActiveX" version of the listbox. I'm assuming you are because you are able to call ListBox1 straight from a module.
PS: The ActiveX controls are members off of the parent sheet object. So if you have the listbox1 on sheet1, you can also call it like Sheet1.ListBox1 so you don't get confused if you end up with multiple sheets with multiple listboxes. Also, you may want to change the name just to make it easier on yourself.
Dim controlName As OLEObject
Set controlName = Sheet1.OLEObjects("ListBox1")
Call populate_listbox(controlName, designAreaArray)
Sub populate_listbox(LB As OLEObject, dataArray As Variant)
Dim i As Integer: i = 0
For i = LBound(dataArray, 2) + 1 To UBound(dataArray, 2) ' Skip header row
LB.Object.AddItem (dataArray(Index, i))
Next i
End Sub
To access the state of a checkbox Active-X control on Sheet1:
Dim checkBox1 As Object
Set checkBox1 = Sheet1.OLEObjects("CheckBox1").Object
MsgBox checkBox1.Value