A useful Set Grid Origin Macro

John... Visio MVP

2010-05-28 02:42:24 UTC

You can shorten the code by
- removing the UndoScope code.
- removing "Item" - replacing things like selectObj.Item(1) with
selectObj(1)

John... Visio MVP

Post by CalgaryBob
Hi All,
If you use Visio for any kind of drafting, you may find it useful to be able
to set the Horizontal or Vertical Grid Origin to a selected shape.
Below are a couple of macros that allow setting the grid origins to a
Sub SetHorizontalGridOrigin()
' Keyboard Shortcut: Ctrl+Shift+H
'
Set selectObj = Application.ActiveWindow.Selection
If selectObj.Count = 0 Then
MsgBox "You must first select a shape to set Horizontal Grid Origin."
Else
Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Ruler & Grid")
Dim vsoShape1 As Shape
Set vsoShape1 = Application.ActiveWindow.Page.PageSheet
If selectObj.Item(1).OneD = True Then
temporigin =
Application.ActiveWindow.Selection.Item(1).CellsSRC(visSectionObject,
visRowXForm1D, vis1DBeginX).FormulaU
Else
temporigin =
Application.ActiveWindow.Selection.Item(1).CellsSRC(visSectionObject,
visRowXFormOut, visXFormPinX).FormulaU
End If
vsoShape1.CellsSRC(visSectionObject, visRowRulerGrid,
visXGridOrigin).FormulaU = temporigin
Application.EndUndoScope UndoScopeID1, True
End If
End Sub
Sub SetVerticalGridOrigin()
' Keyboard Shortcut: Ctrl+Shift+V
'
Set selectObj = Application.ActiveWindow.Selection
If selectObj.Count = 0 Then
MsgBox "You must first select a shape to set Vertical Grid Origin."
Else
Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Ruler & Grid")
Dim vsoShape1 As Shape
Set vsoShape1 = Application.ActiveWindow.Page.PageSheet
If selectObj.Item(1).OneD = True Then
temporigin =
Application.ActiveWindow.Selection.Item(1).CellsSRC(visSectionObject,
visRowXForm1D, vis1DBeginY).FormulaU
Else
temporigin =
Application.ActiveWindow.Selection.Item(1).CellsSRC(visSectionObject,
visRowXFormOut, visXFormPinY).FormulaU
End If
vsoShape1.CellsSRC(visSectionObject, visRowRulerGrid,
visYGridOrigin).FormulaU = temporigin
Application.EndUndoScope UndoScopeID1, True
End If
End Sub
Sub GridOnOff()
' Keyboard Shortcut: Ctrl+g
'
Application.ActiveWindow.ShowGrid = Not
Application.ActiveWindow.ShowGrid
Application.ActiveWindow.ShowGuides = Not
Application.ActiveWindow.ShowGuides
End Sub