I am an experienced Excel VBA coder and have done a little Word VBA but am totally new to Visio VBA. My project opens an Excel file that contains the file names of images. It also contains the X, Y, Width, and Height for each image inserted into a Visio drawing 36 x 48. Each image has a solid line border 12pts wide with square corners. Pin Pos is Top-Left for all.
The code opens Excel and reads the file names and variables for each image (called cards) into arrays. It closes Excel and then inserts the images in a 6 row 7 column drawing using the following procedure. I constructed it using the recorder and then adjusted it to the arrays. Im sure it is not elegant but it works fine except there is about a 4 second delay before the images appear even though the procedure only takes 1.7 seconds to complete (found using the timer).
Private Sub insert_cards() Dim start As Single, sstop As Single Dim r As Long, c As Long, indx As Long Dim shpImg As Visio.Shape Dim UndoScopeID1 As Long Dim UndoScopeID2 As Long Dim UndoScopeID6 As Long Dim endUndoScopeID2 As Long start = Timer For r = 0 To 5 For c = 0 To 6 indx = (r * 7) + c + 1 'indx runs from 1 to 42 not 0 to 41 UndoScopeID1 = Application.BeginUndoScope("Insert") Set shpImg = ActiveWindow.Page.Import(CardPath & CardNames(indx)) UndoScopeID2 = Application.BeginUndoScope("Size & Position 2-D") With shpImg .CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = CXA(c) & "pt" .CellsSRC(visSectionObject, visRowXFormOut, visXFormPinY).FormulaU = RYA(r) & "pt" .CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinX).FormulaU = "Width*0" .CellsSRC(visSectionObject, visRowXFormOut, visXFormLocPinY).FormulaU = "Height*1" .CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = WA(c) & "pt" .CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = H & "pt" UndoScopeID6 = Application.BeginUndoScope("Line Style") .CellsSRC(visSectionObject, visRowLine, visLineColor).FormulaU = "THEMEGUARD(RGB(0,0,0))" .CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "1" .CellsSRC(visSectionObject, visRowGradientProperties, visLineGradientEnabled).FormulaU = "FALSE" .CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "12 pt" .CellsSRC(visSectionObject, visRowLine, visLineEndCap).FormulaU = "2" End With Next Next sstop = Timer - start endUndoScopeID2 = Application.BeginUndoScope("Home") End Sub
I would like the images to appear a row at a time so the user sees action rather than 4 seconds of no action. The last image is still selected at the end which would be nice to fix as well.
I think this must be simple to do. ScreenUpdating did not seem to do anything. Any help or links pointing me in the right direction would be most apprec