If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
A useful Set Grid Origin Macro
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).CellsSR C(visSectionObject, visRowXForm1D, vis1DBeginX).FormulaU Else temporigin = Application.ActiveWindow.Selection.Item(1).CellsSR C(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).CellsSR C(visSectionObject, visRowXForm1D, vis1DBeginY).FormulaU Else temporigin = Application.ActiveWindow.Selection.Item(1).CellsSR C(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 |
#2
|
|||
|
|||
A useful Set Grid Origin Macro
You can shorten the code by
- removing the UndoScope code. - removing "Item" - replacing things like selectObj.Item(1) with selectObj(1) John... Visio MVP "CalgaryBob" wrote in message ... 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).CellsSR C(visSectionObject, visRowXForm1D, vis1DBeginX).FormulaU Else temporigin = Application.ActiveWindow.Selection.Item(1).CellsSR C(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).CellsSR C(visSectionObject, visRowXForm1D, vis1DBeginY).FormulaU Else temporigin = Application.ActiveWindow.Selection.Item(1).CellsSR C(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 |
Thread Tools | |
Display Modes | |
|
|