Grouping specific Shapes by ID in a loop

Started by jakry321, June 15, 2017, 04:20:08 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

jakry321

Hi, in a bit of a pickle.

My code from excel, creates a visio app, sets the page to A1 then it reads a spreadsheet and creates a box for each item and gives it a label based off the cell data. (Two columns for now)
When I have made one "row" of boxes, e.g.  Cell 1,1 and Cell 1,2 I want to group these two shapes.

My general idea is to "select" the shapes based on their ID, which I'm storing in the loop as I go as (ShapeCount), I should probably store it in an array but I'm not worried about that just yet.

However, I'm struggling to just select any 2 shapes and group them.

here is my code


Sub VisioFromExcel()

    Dim AppVisio As Object
    Dim vsoCharacters1 As Visio.Characters
    Dim i As Long
    Dim j As Long
    Dim dXPos As Double
    Dim dYPos As Double
    Dim LRandomNumber As Integer
    Dim ShapeCount As Integer
    Dim intCounter As Integer
    ShapeCount = 0

    Set AppVisio = CreateObject("visio.application")
    AppVisio.Visible = True
   
    AppVisio.Documents.AddEx "", visMSDefault, 0 'Open Blank Visio Document
    AppVisio.Documents.OpenEx "basic_u.vss", visOpenRO + visOpenDocked   'Add Basic Stencil


    AppVisio.ActivePage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = "841 mm"
    AppVisio.ActivePage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = "594 mm"
    AppVisio.ActivePage.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageDrawSizeType).FormulaU = "5"
    AppVisio.ActivePage.PageSheet.CellsSRC(visSectionObject, visRowPage, 38).FormulaU = "2"


    dXPos = AppVisio.ActivePage.PageSheet.Cells("PageWidth") / 2
    dYPos = AppVisio.ActivePage.PageSheet.Cells("PageHeight") / 2


    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        For j = 1 To 2
            ShapeCount = ShapeCount + 1
            AppVisio.Windows.ItemEx(1).Activate
            AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Square"), dXPos, dYPos
       
            Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(ShapeCount).Characters
            vsoCharacters1.Begin = 0
            vsoCharacters1.End = 0
            vsoCharacters1.Text = CStr(Cells(i, j).Value)
           
            AppVisio.ActiveWindow.Page.Shapes.ItemFromID(ShapeCount).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "36 pt"
                If j = 2 Then 'End of the row is 2nd col
               AppVisio.ActiveWindow.DeselectAll
               AppVisio.ActiveWindow.Select AppVisio.ActiveWindow.Page.Shapes.Range(Array((ShapeCount - 1), ShapeCount)).Select, visSelect
               AppVisio.ActiveWindow.Selection.Group  '' This bit is where I want to group
                End If
           
        Next
       
    Next

    Set AppVisio = Nothing
   
End Sub



I currently get error code 438.

I'm know I haven't fully grasped the syntax but I'm just not sure what to do.

I normally write code in python, so I'm not super familiar with VBA. Please be gentle :p

Surrogate


jakry321

   1-            AppVisio.ActiveWindow.Select AppVisio.ActiveWindow.Page.Shapes.Range(Array((ShapeCount - 1), ShapeCount)).Select, visSelect
             2-   AppVisio.ActiveWindow.Selection.Group


When I step through F8, it reaches that 1 line (yellow highlight) then tries to move to the next and fails there.

Surrogate

.Range(Array((ShapeCount - 1), ShapeCount)) You sure that Visio have this objects ?

Yacine

LOL, the deselectall is within the for loop. Deselectall only once before entering the loop.
Yacine

jakry321

 Got it working, code at the bottom:

I made several mistakes, come caused problems, some would cause problems later.

There was(ShapeCount and Shape Count - 1) for Shape IDs as I only called it after creating 2 shapes, so this wasn't an issue but it was a good palace to start investigating, thanks :)


   
Set vsoSelection = AppVisio.ActiveWindow.Selection

vsoSelection.DeselectAll 'ensures nothing is selected before the loop
For j = 1 To Cells(Rows.Count, 1).End(xlUp).Row * 2 'loops through every cell count
vsoSelection.Select AppVisio.ActiveWindow.Page.Shapes.ItemFromID(j), visSelect

If j Mod 2 = 0 Then  'if you have reached the end of the row (col 2), this method allows me to specify any grouping I want
     Set shpgroup = vsoSelection.Group  'groups the items under shpgroup
    vsoSelection.DeselectAll 'ensures that the current two objects are deselected
End If

Next