Let's see if I can explain the routine.
Public Sub Read_Text()
' Define the Visio variables.
Dim DocObj As Visio.Document, mstObj As Visio.Master
Dim pagesObj As Visio.Pages, pageObj As Visio.Page
Dim shpObj As Visio.Shape, shp1obj As Visio.Shape
Dim stnObj As Visio.Document, celObj As Visio.Cell
' Define the other variables.
Dim TextLine As String, Field1 As String, Field2 As String, Field3 As String
Dim i As Integer, j As Integer
Dim ix As Double, iy As Double, maxix As Double
Dim ih As Double, iw As Double
'Turn off screen updating
Visio.Application.ScreenUpdating = False
' Define a starting point and a horizontal and vertical increment
ix = 0: iy = 0: ih = 0.3: iw = 4
' Establish a connection to the current Visio pages
Set pagesObj = ActiveDocument.Pages
' Add a new page to the Visio page collection
Set pageObj = pagesObj.Add
' Indicate that it is not a background page.
pageObj.Background = False
' Create a default rectangular shape and set the size of the text
Set shp1obj = ActivePage.DrawRectangle(0, 0, iw, ih * 2)
Set celObj = shp1obj.Cells("Char.Size")
celObj.Formula = "=8 pt."
' Open the text file to be used with the new shapes
Open "C:\My Documents\Testfields.txt" For Input As #1
' Loop through the text file
Do While Not EOF(1) ' Loop until end of file.
'Read a line of text that will be broken down into three seperate items for
the text to be associated with the Shape.
' This could have done with a single text field, but the idea was to show
how multple fields can be read in and
' how multiple items can be assigned to the text of a shape.
Line Input #1, TextLine ' Read line into variable.
Field1 = Trim(Mid(TextLine, 1, 10))
Field2 = Trim(Mid(TextLine, 11, 20))
Field3 = Trim(Mid(TextLine, 21, 30))
'calculate the new drop location. The location could be part of the text
file.
'It appears that the formulaes post for calculating the horizontal and
vertical location is out of wack.
'The code as described here creates a single row of shapes. The intended
layout was to be several rows starting from the upper left and going down.
'For each pass of the loop, the x value should be incremented. When the x
value exceeds a certain maximum value it should be reset and the y value
incremented.
iy = iy + iw + 0.5
ix = 0
'Don't worry if the shapes are dropped off the edge of the page. Latter on
the size of the page is recalculated and the drawing is recentered on the
new page.
'Drop a copy of the default shape and the calculated location
Set shpObj = ActivePage.Drop(shp1obj, iy, ix)
shpObj.Text = Field1 & " " & Field2 & " " & Field3
'These three lines can be ignored.
ix = ix - (ih * 2)
If ix < maxix Then maxix = ix
ix = ix - (ih * 2)
'Go back and read the next record
Loop
'Close the Text file
Close #1
' Delete the original default rectangular shape.
shp1obj.Delete
' Set the page size based on the location of the shapes placed on the page.
ActivePage.Shapes("thePage").Cells("PageWidth").Formula = Int(iy + 0.5) + 1
ActivePage.Shapes("thePage").Cells("PageHeight").Formula = Int(-maxix + 0.5)
+ 1
' Center the drawing.
ActivePage.CenterDrawing
' Turn screen updating back on
Visio.Application.ScreenUpdating = True
End Sub
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
