Container Zoom to Fit

[Nepherim]

Is there a way to zoom a specific container to fit the window size?

I have a model in which shapes may be in a container. There are many containers. I want to provide a means for the user to choose a container and for that container to be 'zoomed' in to fill the window (or perhaps 75% of the window may be better). I'll put the trigger on a right-click menu option. Just not sure how/if the zoom to fit container is available.

Thanks!

[wapperdude]

You can do this in VBA.

Basically, get the size of the window:  https://msdn.microsoft.com/en-us/vba/visio-vba/articles/window-getwindowrect-method-visio

Then compare container width vs window width and container height vs window height to get appropriate magnification factor.  Set the zoom level to the magnification factor.

Wapperdude

[wapperdude]

Realized I had some code for zooming.  Takes a bit different approach than 1st suggested.  Since it's done in V2007, it's based upon shapes, not containers.  Also, it assumes the shape (container) is selected before running.  No error checking is included.  If you set the Visio behavior option to center selection on zoom, then there is no other code work necessary.

Code Select Expand


Sub setPgZm()

    Dim winMag As Double
    Dim vsoShp As Shape
    Dim shpWid As Double
    Dim shpHt As Double
    Dim pgWid As Double
    Dim pgHt As Double
    Dim widRatio As Double
    Dim htRatio As Double
   
'Use shape based upon selection:
    Set vsoShp = ActiveWindow.Selection(1)
   
    pgWid = ActivePage.PageSheet.CellsU("PageWidth").Result(inch)
    shpWid = vsoShp.CellsU("Width").Result(inch)
    widRatio = pgWid / shpWid
   
    pgHt = ActivePage.PageSheet.CellsU("PageHeight").Result(inch)
    shpHt = vsoShp.CellsU("Height").Result(inch)
    htRatio = pgHt / shpHt
   
    If widRatio < htRatio Then
        winMag = widRatio
    Else
        winMag = htRatio
    End If
   
    ActiveWindow.Zoom = winMag

End Sub

[wapperdude]

Updated code.  Now you do not have to set the Visio option to center selection on zoom.  The code turns it on, and then, when finished, turns it off.

There is another link for similar zooming, but uses mouse wheel:  http://visguy.com/vgforum/index.php?topic=1771.0

Wapperdude

Ed.:  code modified 12/21/2017 to add scaling factor.

Code Select Expand


Sub setPgZm()

    Dim winMag As Double
    Dim vsoShp As Shape
    Dim shpWid As Double
    Dim shpHt As Double
    Dim pgWid As Double
    Dim pgHt As Double
    Dim widRatio As Double
    Dim htRatio As Double
   
'Use shape based upon selection:
    Application.Settings.CenterSelectionOnZoom = True
   
    Set vsoShp = ActiveWindow.Selection(1)
   
    pgWid = ActivePage.PageSheet.CellsU("PageWidth").Result(inch)
    shpWid = vsoShp.CellsU("Width").Result(inch)
    widRatio = pgWid / shpWid
   
    pgHt = ActivePage.PageSheet.CellsU("PageHeight").Result(inch)
    shpHt = vsoShp.CellsU("Height").Result(inch)
    htRatio = pgHt / shpHt
   
    If widRatio < htRatio Then
        winMag = widRatio
    Else
        winMag = htRatio
    End If
   
' Scaling factor:  default would be "2";
    ActiveWindow.Zoom = winMag / 3
    Application.Settings.CenterSelectionOnZoom = False

End Sub

[Nepherim]

Thanks wapperdude, this is exactly what I was looking for, very helpful. For future reference I needed to divide the final winMag by 2 otherwise the container was bigger than the viewport. In the end, for visual impact, I dropped that down to 3.

[wapperdude]

Great!  Thanks.  Yes, at some point I had dropped the "2".  Will modify to use the "3" though, that seems more appropriate.

Cheers.
Wapperdude