Converting a Visio to Tif using Vision5

[Andy Stewartson]

Firstly this is my first real venture into VBA, normally I have used VB6 in
an engineering environment.

I am looking for some help in convert a large number of Visio files from VSD
to TIF using Visio 5. I have got to the point where I have got all the
filename in an array and but I have got stuck in how to process them. I
believe this should be fairly trivial, but I have got stuck

I have an array call vsd_filename() which contains all the filenames

I am expecting the code to look like this (mixture of air code and real)

Dim number_files as Integer
Dim vsd_filename() as String
dim output_filename as String
Dim DocObj As Visio.Document

redim vsd_filename(0)
get_filename vsd_filename() ' <- routine to get all the filename

number_files=ubound(vsd_filename)

for i = 0 to number_files

' load in filename
Set DocObj = Documents.Open(vsd_filename(i))
'
' create output filename exchange VSD for TIF at end
'
output_filename = Left(vsd_filename(i), (Len(vsd_filename(i) - 3))) +
"TIF"


' aircode below
' tif options need to be set
'
set tiff options
'
' save as tif file
'
save output_filename as tif file

' close file
DocObj.Close

next

Hopefully someone can translate/correct/throw away the above into something
useful.

Thanks in advance


Andy Stewartson

 

[John Marshall, MVP]

Take a look at the "Export Pages" example at
http://www.mvps.org/visio/VBA.htm

The key point is that the file extension determines the file format.

John... Visio MVP

Need stencils or ideas? http://www.mvps.org/visio/3rdparty.htm
Need VBA examples? http://www.mvps.org/visio/VBA.htm
Common Visio Questions http://www.mvps.org/visio/common_questions.htm

 

[Andy Stewartson]

John - Thanks for the web site it proved very useful.

I have now got something up and running (code is below), the subrountine is
designed to load a vsd file and then clear the fill and shadow patterns on
all the shapes prior to saving the file as a TIFF. However I have noticed
that when I run the code below for some drawings the fill and shadow
patterns are not cleared for all of the shapes.

Can anyone tell me what I have done wrong in the code below?

Thanks In advance

Andy Stewartson


Private Sub CommandButton3_Click()
'
' declare variables
'
Dim i As Long
Dim j As Long
Dim number_shapes As Long
Dim output_filename As String
Dim oldResponse As Integer

Dim docObj As Visio.Document
Dim pagsObj As Visio.Pages
Dim shpObjs As Visio.Shapes
Dim pagobj As Visio.Page
Dim shpObj As Visio.Shape
Dim cel1Obj As Visio.Cell
Dim cel2Obj As Visio.Cell
'
' store current response setting
'
oldResponse = Visio.Application.AlertResponse
'
' set to answer no as to not same the visio file after the mods
'
Visio.Application.AlertResponse = 7
'
' start looping through files
'
For i = 1 To number_files
'
' load file
'
Set docObj = Documents.Open(vsd_filename(i))
'
' set page pointer
'
Set pagsObj = docObj.Pages
'
' set to page 1 - drawing only have one page
'
Set pagobj = pagsObj.Item(1)
'
' set top level pointer to shapes
'
Set shpObjs = pagobj.Shapes
'
' loop through all the shapes
'
For j = 1 To shpObjs.Count
'
' set pointers
'
Set shpObj = shpObjs(j)
Set cel1Obj = shpObj.Cells("FillPattern")
Set cel2Obj = shpObj.Cells("ShdwPattern")
'
' clear fill and shadow patterns
'
cel1Obj.Formula = "0"
cel2Obj.Formula = "0"
'
' loop for next shape
'
Next
'
' create output filename
'
output_filename = Left(vsd_filename(i), (Len(vsd_filename(i)) - 3))
+ "TIF"
'
' export file
'
' pagobj.Export output_filename - temporary rem out so that don't
waste time
'
' close file
'
docObj.Close
'
' loop for next file
'
Next
'
' restore default response
'
Visio.Application.AlertResponse = oldResponse
'
' end of subroutine
'
End Sub