You might try something like this,
al
'
' there is a problem with a 1D shape in that pinX/pinY
' may not be the real center of the shape
' debug on another day
'
Private Sub searchZoomObject(strObject As String)
On Error Resume Next
Dim visApp As Visio.Application
Dim visWin As Visio.Window
Dim visDoc As Visio.Document
Dim visPage As Visio.Page
Dim visShape As Visio.Shape
Dim visCell As Visio.Cell
Set visApp = ThisDocument.Application
Set visDoc = ThisDocument.pWorkDoc
Set visPage = visApp.ActivePage
Set visWin = visApp.ActiveWindow
visWin.DeselectAll
Set visShape = visPage.Shapes(strObject)
visWin.Select visShape, 2
Dim dblLeft As Double
dblLeft = 0
Dim dblTop As Double
dblTop = 0
Dim dblWidth As Double
dblWidth = 0
Dim dblHeight As Double
dblHeight = 0
Set visCell = visShape.Cells("width")
dblWidth = visCell.ResultIU
Set visCell = visShape.Cells("height")
dblHeight = visCell.ResultIU
Set visCell = visShape.Cells("pinx")
dblLeft = visCell.ResultIU - (dblWidth * 0.5)
Set visCell = visShape.Cells("piny")
dblTop = visCell.ResultIU + dblHeight + (dblHeight * 0.1)
dblHeight = dblHeight
dblWidth = dblWidth
visWin.SetViewRect dblLeft, dblTop, dblWidth, dblHeight
' show the linked record in the external data window
ShowSelectedObjectDataRecord visShape
End Sub
'
' if a shape is selected because of a search, the data link function may
' not be active so we force the display of the appropriate data recordset
'
Private Sub ShowSelectedObjectDataRecord(visShape As Visio.Shape)
'
' this piece of code handles selecting an object and then if it
' is linked to a data recordset, open the external data window and
' select the recordset and record appropriate to the object
'
Dim alngDataRecordsetIDs() As Long
Dim lngRowId As Long
Dim lngRecordSetId As Long
Dim winExternalData As Visio.Window
Dim visDataRecordset As Visio.DataRecordset
Dim intX As Integer
' get the list of recordset ids associated if any
visShape.GetLinkedDataRecordsetIDs alngDataRecordsetIDs
If UBound(alngDataRecordsetIDs) <> -1 Then
' take the first recordset id
lngRecordSetId = alngDataRecordsetIDs(0)
' get the associate row id
lngRowId = visShape.GetLinkedDataRow(lngRecordSetId)
Set winExternalData =
Application.ActiveWindow.Windows.ItemFromID(visWinIDExternalData)
' show the external data window
winExternalData.Visible = True
' set the linked row
Set visDataRecordset =
Application.ActiveDocument.DataRecordsets.ItemFromID(lngRecordSetId)
winExternalData.SelectedDataRecordset = visDataRecordset
winExternalData.SelectedDataRowID = lngRowId
End If ' test for number of recorsetids associated
End Sub
Post by Michael GlennHello all,
I am in the process of writing a custom search form that gives me a list of
shapes. I want to be able to click on a search result, activate the
appropriate page and zoom in on the shape. I'm up to the "zoom in on the
shape part". How do I zoom the page and center it on the shape?
Thanks for your suggestions!
Michael