Cropping a visio shape by VBA code?

[Lex_Switzerland]

Hello,

I am using a map on which I place a dot to indicate a geographical location.
Now I would like to crop the map around that particular dot (for example at
10 points distance on each side) and then save the resulting cropped map as a
gif image. The ultimate intention is to automatically generate several
orientation map - each showing the corresponding dot surrounded by a
specified range of map details.

I tried to find the crop command and I also tried to record a macro to
reveal the code. I couldn't find either of them...

I would be very grateful for your help!

Lex

 

[junethesecond]

Crop tool works on foreign image.
So, please save a map as JPEG file,
insert it with menu from file or
by copy-paste, then use crop tool.
To start crop, press trimming tool button,
or press keys, "shift+ctrl+2".

 

[Al Edlund]

you might try something like this

Sub DrawCircle_BoxIt_SaveAsGif

Dim dLeft As Double
Dim dTop As Double
Dim dWidth As Double
Dim dHeight As Double
Dim dPinX As Double
Dim dPinY As Double

Application.Windows.ItemEx("Drawing1.vsd").Activate
Application.ActiveWindow.Page.Drop
Application.Documents.Item("BASIC_U.VSS").Masters.ItemU("Circle"), 2.75,
8.25

' open the shape sheet and update where we want the circle for ease of
discussion
Application.ActiveWindow.Page.Shapes.ItemFromID(1).OpenSheetWindow
dWidth = 1.5
Application.ActiveWindow.Shape.CellsSRC(visSectionObject,
visRowXFormOut, visXFormWidth).FormulaU = CStr(dWidth)
dHeight = 1.5
Application.ActiveWindow.Shape.CellsSRC(visSectionObject,
visRowXFormOut, visXFormHeight).FormulaU = CStr(dHeight)
dPinX = 2.75
Application.ActiveWindow.Shape.CellsSRC(visSectionObject,
visRowXFormOut, visXFormPinX).FormulaU = CStr(dPinX)
dPinY = 7.25
Application.ActiveWindow.Shape.CellsSRC(visSectionObject,
visRowXFormOut, visXFormPinY).FormulaU = CStr(dPinY)
Application.ActiveWindow.Close


dLeft = dPinX - (dWidth / 2)
dTop = dPinY + (dHeight / 2)

Application.ActiveWindow.SetViewRect dLeft, dTop, dWidth, dHeight

Application.ActiveWindow.Page.Export "C:\Drawing1.gif"

End Sub

Al