Help with VBA Code

[Becky N]

Hello,

I am trying to create org charts in visio that will be about 40ish pages
long. I am using the wizard to create the charts. Since I am not able to
simply "refresh" the charts by updating my data file I will need to run and
rerun these charts many times. One of the issues I am having is that my chart
is sometimes wider and longer than the page size. I am trying to find some
sort of code (or any solution) that will allow me to shrink the drawing to
the page.

I found some code that is supposed to do this but I am having trouble
piecing it together as it is part of A LOT more code (I have very limited
knowledge in VBA, so I apologize if I don't sound that intelligent with it).
Here are the pieces and parts that I have. Can someone help me put this
together so I can insert it into my document and have it work? I keep getting
"Compile Error: Invalid statement inside type block."

Thanks for your help!

Public Type OrgStruc 'Define user-defined type.
Dim visaddon As Visio.Addon
Dim visdoc As Visio.Document 'Individual Document
Dim winObj As Visio.Window 'Individual Windows
Dim pagsObj As Visio.Pages 'Pages collection
Dim pagObj As Visio.Page 'Page in collection
Dim shpObjs As Visio.Shapes 'Shapes collection
Dim shpObj As Visio.Shape 'Shape in collection
End Type

Sub ChangeZoom()
'Set the object window to be the active window
Set winOjb = ActiveWindow
ActiveWindow.Page = pagObj.Name
'Set the window zoom to be 75%
winObj.Activate

If Not FitsOnPage(pagObj) Then
Set visaddon = ActiveDocument.Application.Addons.Item("OrgC")
visaddon.Run ("/cmd=FitToPage")
End If

'change zoom
'show window as 75% of page
winObj.Zoom = 0.75

End Sub

Private Function FitsOnPage(ovPage As Visio.Page) As Boolean

' Tests if the bounding box enclosing the shapes on the page
' fit within the current page. Note that this does NOT
' take page margins into account!

Dim bFits As Boolean
Dim dLeft As Double
Dim dRight As Double
Dim dTop As Double
Dim dBottom As Double
Dim dWidth As Double
Dim dHeight As Double

' Assume it fits
bFits = True

' Are there any shapes?
If ovPage.Shapes.Count > 0 Then

' Get the bounding box of all of the shapes on the page
' (the values are in 'internal units' -- inches)
ovPage.BoundingBox visBBoxUprightWH, dLeft, dBottom, dRight, dTop

' Check left (must be >= 0)
If dLeft < 0# Then
bFits = False

' Check bottom (must be >= 0)
ElseIf dBottom < 0# Then
bFits = False

' Check right (must be <= page width in internal units)
ElseIf dRight > ovPage.PageSheet.Cells("PageWidth").ResultIU Then
bFits = False

' Check top (must be <= page height in internal units)
ElseIf dTop > ovPage.PageSheet.Cells("PageHeight").ResultIU Then
bFits = False

End If

End If

FitsOnPage = bFits

End Function

 

[JuneTheSecond]

Hi, I would like to recommend you to place "Option Explicit" at the first line.
And then you can quickly find what is the problem, if you compile your code.
Next modified code passed the compiler, but I cannot see what the program
does.

Option Explicit
Dim visaddon As Visio.Addon
Dim visdoc As Visio.Document 'Individual Document
Dim winObj As Visio.Window 'Individual Windows
Dim pagsObj As Visio.Pages 'Pages collection
Dim pagObj As Visio.Page 'Page in collection
Dim shpObjs As Visio.Shapes 'Shapes collection
Dim shpObj As Visio.Shape 'Shape in collection

Sub ChangeZoom()
'Set the object window to be the active window
'Set winObj = ActiveWindow
'ActiveWindow.Page = pagObj.Name
'Set the window zoom to be 75%
'winObj.Activate
'Set pagObj = winObj.Page
If Not FitsOnPage(ActivePage) Then
Set visaddon = ActiveDocument.Application.Addons.Item("OrgC")
visaddon.Run ("/cmd=FitToPage")
End If

'change zoom
'show window as 75% of page
winObj.Zoom = 0.75

End Sub

Private Function FitsOnPage(ovPage As Visio.Page) As Boolean

' Tests if the bounding box enclosing the shapes on the page
' fit within the current page. Note that this does NOT
' take page margins into account!

Dim bFits As Boolean
Dim dLeft As Double
Dim dRight As Double
Dim dTop As Double
Dim dBottom As Double
Dim dWidth As Double
Dim dHeight As Double

' Assume it fits
bFits = True

' Are there any shapes?
If ovPage.Shapes.Count > 0 Then

' Get the bounding box of all of the shapes on the page
' (the values are in 'internal units' -- inches)
ovPage.BoundingBox visBBoxUprightWH, dLeft, dBottom, dRight, dTop

' Check left (must be >= 0)
If dLeft < 0# Then
bFits = False

' Check bottom (must be >= 0)
ElseIf dBottom < 0# Then
bFits = False

' Check right (must be <= page width in internal units)
ElseIf dRight > ovPage.PageSheet.Cells("PageWidth").ResultIU Then
bFits = False

' Check top (must be <= page height in internal units)
ElseIf dTop > ovPage.PageSheet.Cells("PageHeight").ResultIU Then
bFits = False

End If

End If

FitsOnPage = bFits

End Function

 

[Becky N]

Thanks for the tip. I did that, but am still getting the same error.

The program is supposed to look at the drawing and if it is flowing over any
of the sides of the pages (the left, right, top or bottom) then it shrinks
the drawing so that it does not flow over th edges. I have no idea if the
program works the way it is written. I found it somewhere and was hoping for
the best.

Any other suggestions? I really appreciate the help.

 

[AlEdlund]

You didn't mention what version of visio you're at. I think the add-on ORGC
that you're calling is in v2003. The add-ons sometimes change between
versions of visio.
al

 

[Becky N]

Sorry, I am in Visio 2003.

Thank you!

You didn't mention what version of visio you're at. I think the add-on ORGC
that you're calling is in v2003. The add-ons sometimes change between
versions of visio.
al

 

[AlEdlund]

first.
The reason your code failed was that type definitions like standard types
(integer, string, etc.). So you get rid of the type and just keep the
definitions that are needed. The second issue is that the 'changezoom' has
some minor issues in it. In either case:
Open the vba editor, and copy this into the 'ThisDocument', it should show
up in the 'tools=>macros=>thisdocument'
HTH
al


Option Explicit

Public winObj As Visio.Window
Public pagObj As Visio.Page
Public visAddon As Visio.Addon

Sub ChangeZoom()
'Set the object window to be the active window
Set winObj = Application.ActiveWindow
Set pagObj = Application.ActivePage

ActiveWindow.Page = pagObj.Name
'Set the window zoom to be 75%
winObj.Activate

If Not FitsOnPage(pagObj) Then
Set visAddon = ActiveDocument.Application.Addons.Item("OrgC")
visAddon.Run ("/cmd=FitToPage")
End If

'change zoom
'show window as 75% of page
winObj.Zoom = 0.75

End Sub

Private Function FitsOnPage(ovPage As Visio.Page) As Boolean

' Tests if the bounding box enclosing the shapes on the page
' fit within the current page. Note that this does NOT
' take page margins into account!

Dim bFits As Boolean
Dim dLeft As Double
Dim dRight As Double
Dim dTop As Double
Dim dBottom As Double
Dim dWidth As Double
Dim dHeight As Double

' Assume it fits
bFits = True

' Are there any shapes?
If ovPage.Shapes.Count > 0 Then

' Get the bounding box of all of the shapes on the page
' (the values are in 'internal units' -- inches)
ovPage.BoundingBox visBBoxUprightWH, dLeft, dBottom, dRight, dTop

' Check left (must be >= 0)
If dLeft < 0# Then
bFits = False

' Check bottom (must be >= 0)
ElseIf dBottom < 0# Then
bFits = False

' Check right (must be <= page width in internal units)
ElseIf dRight > ovPage.PageSheet.Cells("PageWidth").ResultIU Then
bFits = False

' Check top (must be <= page height in internal units)
ElseIf dTop > ovPage.PageSheet.Cells("PageHeight").ResultIU Then
bFits = False

End If

End If

FitsOnPage = bFits

End Function

 

[Becky N]

Thanks Al. I don't get an errors anymore and it does change the zoom on the
page you are on. we're making progress! However, it doesn't shrink the chart.
It was my understanding that the Private Function FitsonPage was supposed to
shrink the chart down to fit on the page. Any ideas on why or other ideas on
how to make it do this?

 

[AlEdlund]

Becky,
I just tested with a very small chart (half dozen entities). Can you share a
drawn chart? My other id is edlund60014 lives over on yahoo.
al

 

[AlEdlund]

replied off-line,
al

I just sent it over. The subject is Sample Org Chart from Becky N.

Thank you so much!