A Microsoft Office (Excel, Word) forum. OfficeFrustration

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.

Go Back   Home » OfficeFrustration forum » Microsoft Powerpoint, Publisher and Visio » Visio
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

A useful Set Grid Origin Macro



 
 
Thread Tools Display Modes
  #1  
Old May 27th, 2010, 10:43 PM posted to microsoft.public.visio.general
CalgaryBob
external usenet poster
 
Posts: 6
Default 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  
Old May 28th, 2010, 03:42 AM posted to microsoft.public.visio.general
John... Visio MVP
external usenet poster
 
Posts: 900
Default 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

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump


All times are GMT +1. The time now is 11:18 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.