Help fixing pic resize code

[sdaspenberg]

I'm not a programmer, but I pieced together this code to position and resize 15 pics on a page. The problem I'm having is the code comes back with an error if I run it with less than 15 pics. I would like to be able to run this code for up to 15 pics not just 15. Any ideas or help would be greatly appreciated.

here is the code:

Sub ResizePics()

   Dim UndoScopeID1 As Long
   UndoScopeID1 = Application.BeginUndoScope("Size Objects")
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "2.1747 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
  (Above section repeated for shapes 2-15)
   Application.EndUndoScope UndoScopeID1, True

End Sub

[bobsupercow]

A couple of notes:

• 1. You should learn about implementing loops. In particular For loops in VBA are very simple to learn.
• 2. The "If vsoShape.CellsSRCExists(...)" line is there to prevent attempting to resize every shape.
• 3. Use the "code" tags when posting code. It makes it much easier to read.

Code Select Expand


    Friend Sub ResizePics()
        Dim vsoShape As Visio.Shape
        For Each vsoShape In Application.ActiveWindow.Page.Shapes
            If vsoShape.CellsSRCExists(visSectionObject, visRowXFormOut, visXFormPinX) Then
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "2.1747 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
            End If
        Next vsoShape
    End Sub


[sdaspenberg]

bobsupercow,

Thanks for the help, but I couldn't get the code you posted to work at all. It gave me a compile error argument not optional for "vsoShape.CellsSRCExists" section.

Let me further explain what I'm trying to do. I need to place job site photos on the page. The original macro I created would arrange the photos on the page for me. I created the macro to arrange 15 photos. I need the macro to work whether I have 1 photo or 15. The macro does what I need it to do with less then 15 photos but it gives me an error and the "Undo" command in Visio does not work until I restart the program. Here is the error: Run time error '-2032465756 (86db08a4)':  Invalid sheet identifier.

Once again if anyone has any ideas or thoughts I would appreciate it.
Thanks

[Jumpy]

Slightly altered Version of bobsupercow's code:

Code Select Expand


Sub ResizePics()
        Dim vsoShape As Visio.Shape, i as Integer
        For Each vsoShape In Application.ActiveWindow.Page.Shapes
          If vsoShape.CellsSRCExists(visSectionObject, visRowXFormOut, visXFormPinX,True) Then
                i=i+1         
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = 2.9*i & " in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
                vsoShape.CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
           End If
        Next vsoShape
End Sub


The code lines up horizontal every shape on the page. Added a count variable i for that.
The problem with vsoShape.CellsSRC was, that a parameter was missing (needed: S,R,C, ExistsLocally)

[Jumpy]

What you could do, too, but should not really do, because it will haunt you some day is to add one line to your code that makes you ignore errors, when less than 15 shapes are on the page:

Code Select Expand


Sub ResizePics()
    Dim UndoScopeID1 As Long

    On Error Resume Next   'This line here. Try it out but then use the other way!!!!!!!

   UndoScopeID1 = Application.BeginUndoScope("Size Objects")
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "2.1747 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
   Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
  (Above section repeated for shapes 2-15)
   Application.EndUndoScope UndoScopeID1, True

End Sub


[sdaspenberg]

Jumpy,
thanks for the help.
I've tried to implement some of the code you and bobsupercow have posted, especially the If/Then statements. I still can't seem to get it to work. It still gives me an error when it reaches the code for shapes I don't have on the page. I thought the If/Then statement would take care of that.
Here's where I'm at now. This is a sample of the code for only 5 shapes.

Code Select Expand


Sub ResizePics()

   Dim UndoScopeID1 As Long
   UndoScopeID1 = Application.BeginUndoScope("Size Objects")
   If Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(vixSectionObject, visRowXFormOut, visXFormPinX, True) Then
       Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "2.1747 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
       Application.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
   End If
   If Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(vixSectionObject, visRowXFormOut, visXFormPinX, True) Then
       Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "5.3381 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
       Application.ActiveWindow.Page.Shapes.ItemFromID(2).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
   End If
   If Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(vixSectionObject, visRowXFormOut, visXFormPinX, True) Then
       Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "8.5014 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
       Application.ActiveWindow.Page.Shapes.ItemFromID(3).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
   End If
   If Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(vixSectionObject, visRowXFormOut, visXFormPinX, True) Then
       Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "11.6648 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
       Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
   End If
   If Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(vixSectionObject, visRowXFormOut, visXFormPinX, True) Then
       Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = "14.8281 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = "9.2945 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "2.8398 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "2.1299 in"
       Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0.5"
       Application.ActiveWindow.Page.Shapes.ItemFromID(5).CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*0.5"
   End If
   Application.EndUndoScope UndoScopeID1, True

End Sub



[wapperdude]

Try Jumpy's first code version.  It iterates thru all of the shapes, regardless of how many, no more, no less.  Only requires the one For / Next loop and the one If statement.

Wapperdude

[sdaspenberg]

I've tried Jumpy's code, but it arranges the photos all in a horizontal line. My code arranges them exactly where I want them on the page.

[sdaspenberg]

Here is a sample layout of the photos once they have been arranged by my original code. Like I said, it gives me an error when I don't have 15 photos on the page.

[sdaspenberg]

Sorry, guess I don't know how to load a photo into my post.

[Paul Herber]

Use the "Additional Options" and "Attach" at the bottom of the Post Reply page.

[sdaspenberg]

Thanks Paul
Here's a sample of what my original code does with 15 photos. It works with less than 15, but it gives me an error.

[Paul Herber]

Here's a sample of what my original code does with 15 photos. It works with less than 15, but it gives me an error.

You've been given good examples of how to loop through all your images, do it properly, if you don't you will get errors.

[sdaspenberg]

Paul,
I've been trying to do it properly. That's why Im on this forum. To ask those who are much more knowledgeable than me. The code from Jumpy and bobsupercow has been very helpful, but it doesn't do exactly what I need it to do. So I've been trying grasp the concepts they're using as far as the loops and if then statements, but I can't seem to make them work for my macro. I know very little about programming. I just need to speed up some of the work I do in Visio by using macros. So I just need someone to look at the code I've posted last and see what I'm doing wrong. If I'm becoming a nuisance I will look for info elsewhere.

[Paul Herber]

Sorry, I didn't mean my response to come out quite like that. Look at Jumpy's code, the For Each line and then the line below that are the lines required to loop through all your shapes.