Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all articles
Browse latest Browse all 21848

Visio 2013 Reference To Selected Shape

$
0
0
Hi I am a novice please bear with me.

Setup: Visual Basic with Office 365 & Visio 2013.
I am trying to run a macro from a shape. I used the following,

http://msdn.microsoft.com/en-us/libr.../ff765424.aspx
Associate Macros or Add-ons with the Double-Click Behavior of Shapes
1. Select the shape with which you want to associate the macro or add-on.
2. On the Developer tab, click Behavior.
3. In the Behavior dialog box, click Double-Click, and then click Run macro.
4. From the Run macro list, select the macro or add-on you want to run.
5. Click OK.
6. Double-click the shape to run the macro or add-on.

What I am trying to do is run the macro having selected a shape but I don't know how to write the code to reference the shape selected. This is the code
Sub BrickFill()

'Enable diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Fill Effects")
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaForceU = "THEMEGUARD(THEMEVAL(""AccentColor""))"
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaForceU = "THEMEGUARD(RGB(255,255,255))"
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "2"
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowGradientProperties, visFillGradientEnabled).FormulaU = "FALSE"
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowGradientProperties, visRotateGradientWithShape).FormulaU = "FALSE"
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowGradientProperties, visUseGroupGradient).FormulaU = "FALSE"
Application.EndUndoScope UndoScopeID1, True

Dim UndoScopeID2 As Long
UndoScopeID2 = Application.BeginUndoScope("Fill Effects")
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "USE(""Brick"")"
Application.EndUndoScope UndoScopeID2, True

Dim UndoScopeID3 As Long
UndoScopeID3 = Application.BeginUndoScope("Fill Effects")
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(255,255,255))"
Application.EndUndoScope UndoScopeID3, True

Dim UndoScopeID4 As Long
UndoScopeID4 = Application.BeginUndoScope("Fill Effects")
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowFill, visFillBkgnd).FormulaU = "THEMEGUARD(MSOTINT(THEMEVAL(""AccentColor""),40))"
Application.EndUndoScope UndoScopeID4, True

Dim UndoScopeID5 As Long
UndoScopeID5 = Application.BeginUndoScope("Line Style")
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "0"
Application.ActiveWindow.Page.Shapes.ItemFromID(4485).CellsSRC(visSectionObject, visRowGradientProperties, visLineGradientEnabled).FormulaU = "FALSE"
Application.EndUndoScope UndoScopeID5, True

'Restore diagram services
ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

Help would be appareicated.

Viewing all articles
Browse latest Browse all 21848

Trending Articles