A useful Set Grid Origin Macro

[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
selected shape:


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

 

[John... Visio MVP]

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

John... Visio MVP