View Single Post
  #1  
Old May 25th, 2010, 06:58 PM posted to microsoft.public.visio.general
CalgaryBob
external usenet poster
 
Posts: 6
Default Need Help with Grid Origin Macro I wrote

Hi All,

I have written a macro to set the Grid Origin (Either Vertical or
Horizontal) to the X-Position or Y-Position of a selected Shape.

It works well if the selected Shape is of the type that uses only a single X
and Y Co-ordinate, but if I try to run the macro when the selected shape uses
Begin X, End X and Begin Y, End Y Co-ordinates, I get an error, and a pop-up
to allow debugging of the macro.

This in itself is not a problem, but the Undo command no longer works after
the error is encountered, the only way to get Undo to work is to close the
Visio App.

The macros I'm using are shown below, I'm hoping someone could show me how
to modify the nacro to avoid the error by using some sort of error checking"


MACROS:

Sub Guide_Set_Vertical()
' Keyboard Shortcut: Ctrl+Shift+X
'

Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Ruler & Grid")
Dim vsoShape1 As Shape
Set vsoShape1 = Application.ActiveWindow.Page.PageSheet
'ID = Application.ActiveWindow.Selection.Item(1).

temporigin =
Application.ActiveWindow.Selection.Item(1).CellsSR C(visSectionObject,
visRowXFormOut, visXFormPinX).FormulaU

vsoShape1.CellsSRC(visSectionObject, visRowRulerGrid,
visXGridOrigin).FormulaU = temporigin
Application.EndUndoScope UndoScopeID1, True

End Sub
Sub Guide_Set_Horizontal()
' Keyboard Shortcut: Ctrl+Shift+Y
'
Dim UndoScopeID1 As Long
UndoScopeID1 = Application.BeginUndoScope("Ruler & Grid")
Dim vsoShape1 As Shape
Set vsoShape1 = Application.ActiveWindow.Page.PageSheet
'ID = Application.ActiveWindow.Selection.Item(1).

temporigin =
Application.ActiveWindow.Selection.Item(1).CellsSR C(visSectionObject,
visRowXFormOut, visXFormPinY).FormulaU
vsoShape1.CellsSRC(visSectionObject, visRowRulerGrid,
visYGridOrigin).FormulaU = temporigin
Application.EndUndoScope UndoScopeID1, True
End Sub
Sub GridOnOff()
' Keyboard Shortcut: Ctrl+g
'

Application.ActiveWindow.ShowGrid = Not Application.ActiveWindow.ShowGrid
Application.ActiveWindow.ShowGuides = Not
Application.ActiveWindow.ShowGuides

End Sub