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
which code line get this error ?
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.
.Range(Array((ShapeCount - 1), ShapeCount))
You sure that Visio have this objects ?
LOL, the deselectall is within the for loop. Deselectall only once before entering the loop.
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