VBA Express : Visio - Shape size and location list

Visio

Shape size and location list

Ease of Use

Easy

Version tested with

2003

Submitted by:

Brandtrock

Description:

This routine will create a text file of the location and size of all 2-d shapes on the current page.

Discussion:

Create a text file listing where the 2-d shapes in a document are located. The x and y locatons, width, and height, as well as the object's text are recorded in the .txt log. Running this from a document close event could be used to track changes made to the document.

Code:

instructions for use

			Option Explicit 
 
Public Sub LocationTable() 
     'This routine will create a text file of the location and size of all 2-d shapes
     ' on the current page
    Dim shpObj     As Visio.Shape, celObj As Visio.Cell 
    Dim ShpNo      As Integer, Tabchr     As String, localCent As Double 
    Dim LocationX  As String, LocationY   As String 
    Dim ShapeWidth As String, ShapeHeight As String 
     
     'Open or create text file to write data
    Open "C:\LocationTable.txt" For Output Shared As #1 
     
    Tabchr = Chr(9) 'Tab
     
     'Loop Shapes collection
    For ShpNo = 1 To Visio.ActivePage.Shapes.Count 
         
        Set shpObj = Visio.ActivePage.Shapes(ShpNo) 
        If Not shpObj.OneD Then ' Only list the 2-D shapes
             
             'Get location Shape
            Set celObj = shpObj.Cells("pinx") 
            localCent = celObj.Result("inches") 
            LocationX = Format(localCent, "000.0000") 
            Set celObj = shpObj.Cells("piny") 
            localCent = celObj.Result("inches") 
            LocationY = Format(localCent, "000.0000") 
             
             'Get Size Shape
            Set celObj = shpObj.Cells("width") 
            localCent = celObj.Result("inches") 
            ShapeWidth = Format(localCent, "000.0000") 
            Set celObj = shpObj.Cells("height") 
            localCent = celObj.Result("inches") 
            ShapeHeight = Format(localCent, "000.0000") 
             
             'Write values to Text file starting Name of Shape
            Print #1, shpObj.Name; shpObj.Text; Tabchr; _ 
            Tabchr; LocationX; Tabchr; LocationY; _ 
            Tabchr; ShapeWidth; Tabchr; ShapeHeight 
        End If 
         
    Next ShpNo 
     'Close Textfile
    Close #1 
     
     'Clean Up
    Set celObj = Nothing 
    Set shpObj = Nothing 
End Sub

How to use:

Open your Visio document.
Press Alt + F11 to launch the Visual Basic Editor (VBE).
Select Insert>Module from the Menu Bar in the VBE.
Copy the code from above.
Paste the code in the right hand window of the VBE.
Close the VBE.
From the Visio document, select Tools>Macro>Macros (or press Alt + F8).
Highlight LocationTable in the list of macros.
Press run.

Test the code:

Open the example file.
Run the LocationTable macro per the instructions above.
Add a 2d shape to the document.
Run the LocationTable macro again.
Notice that the shape you added is now listed in the text document.
When you are convinced that it works right, place the code in your document and run it.

Sample File:

VBAX_Visio2.zip 99.93KB

Approved by mdmackillop

This entry has been viewed 91 times.