Scale Shape on Zoom


  • Web maps have push pin location shapes that rescale to maintain the same size when zooming in and out.  I'd like to mimic that behavior in Visio 2010.

    So I created a push pin Visio Shape (0.5 in Height, 0.25 in Width) to recreate that feature, but it's not clear to me how to edit the Height/Width ShapeSheet cells with a zoom status formula.  I did a Macro capture of a down, up and back zoom using View->Zoom that generated this code:

    Sub Macro2()
        'Enable diagram services
        Dim DiagramServices As Integer
        DiagramServices = ActiveDocument.DiagramServicesEnabled
        ActiveDocument.DiagramServicesEnabled = visServiceVersion140
        Application.ActiveWindow.Zoom = 0.75
        Application.ActiveWindow.Zoom = 1.5
        Application.ActiveWindow.Zoom = 1#
        'Restore diagram services
        ActiveDocument.DiagramServicesEnabled = DiagramServices
    End Sub

    I see that I would divide the base values by the zoom value.  But don't know the way to refer to the ActiveWindow zoom value.  Any clever ideas on how to complete the process?



    Steve Mack

    Thursday, March 22, 2012 2:58 PM


  • Steve,

    I use something like this to zoom on a shape,



        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

    If this answer solves your problem, please check Mark as Answered. If this answer helps, please click the Vote as Helpful button. Al Edlund Visio MVP

    Thursday, March 22, 2012 3:33 PM