Visio tips & tricks for Interaction Designers

This page is intended for Interaction Designers who are using Visio and are interested in getting the most out of Visio. Several people from the Netherlands have contributed to the information on this page. If you have something to add or comment, let me know.

· Duplicating a page · Fixing the print settings · Set zoom of all page to 'fit to page'

· Paste as unformatted text · Copy/paste in place · Copy page to doc

· Create table of contents

Visio allows you to add new functionality by adding macro's. To add macro's, go to "Tools->Macros->Visual Basic Editor' and select "Visio objects->ThisDocument". By cut-and-pasting you can add new macro's to your document.

Duplicating a page

This macro makes a copy of a page with all its contents. This is useful whan you have to create a new page that is almost identical to an existing one.

Public Sub CopyPage()
    Dim currPage As Visio.Page
    Dim newPage As Visio.Page
    Dim maxNr As Integer
    Dim currBackPage As String
    Dim currPageName As String
    Dim allShapes As Visio.Selection
    Dim groupedShapes As Visio.Shape
    
    ' Group all shapes on the current page and copy them to clipboard
    ActiveWindow.SelectAll
    Set allShapes = ActiveWindow.Selection
    Set groupedShapes = allShapes.Group
    groupedShapes.Copy visCopyPasteNoTranslate
    groupedShapes.Ungroup
    
    ' Create the new page
    Set currPage = ActivePage
    Set newPage = ActiveDocument.Pages.Add
    If Not (currPage.Background) Then
        'if current page is a background page, don't set index
        newPage.Index = currPage.Index + 1
    End If
    
    ' Create a proper name for the new page
    currPageName = currPage.Name
    maxNr = Len(currPageName)
    If (maxNr > 24) Then
        maxNr = 24
    End If
    newPage.Name = Left(currPageName, maxNr) + " (copy)"
    
    'Paste the grouped shapes
    newPage.Paste visCopyPasteNoTranslate
    If newPage.Shapes.Count Then
        newPage.Shapes.Item(1).Ungroup
    End If
    ActiveWindow.DeselectAll
End Sub
    

Fixing the print settings of all pages

This macro sets the printing settings for all pages. Somehow Visio allows you to make per page changes and this macro sets them back to what you want it to be.

Public Sub MakeAllA3()
    Application.ActiveDocument.PaperSize = visPaperSizeA3
    Application.ActiveDocument.PrintFitOnPages = True
    Application.ActiveDocument.PrintLandscape = True
    Application.ActiveDocument.PrintPagesAcross = 1
    Application.ActiveDocument.PrintPagesDown = 1
End Sub

Setting the zoom factor of all pages to 'fit to page'

If you work with multiple pages you will have noticed that Visio stores zooming level per page. This macro sets the zoom factor of all pages back to 'fit to page' so you can click through all pages and not be faced with different zoom factors for every page.

Public Sub FitToPageAll()
    Dim PageToIndex As Visio.Page
    Dim curPage As Visio.Page

    Set curPage = ActivePage

    ' loop through all the pages you have and set the zoom factor
    For Each PageToIndex In ActiveDocument.Pages
        ActiveWindow.Page = ActiveDocument.Pages(PageToIndex.Index).Name
        ActiveWindow.Zoom = -1
    Next
    
    ActiveWindow.Page = curPage
End Sub

Paste as unformatted text

This macro does (almost) the same thing as the 'Paste Special' menu item and selects 'paste as unformatted text'. This macro makes it possible to assign a keyboard shortcut to it which is the main reason for creating this macro in the first place. Note that is doesn't work properly if you are already in editing more of an element....sorry, don't know how to do that :-(

Public Sub PasteAsText()
    Dim objShps As Visio.Selection
    Dim obj As Visio.Shape
    Dim dummy As Visio.Shape
    Dim oldStyle As String
    
    
    'get the Selection
    Set objShps = Visio.ActiveWindow.Selection
    If (objShps.Count = 1) Then
        Set obj = objShps(1)
        oldStyle = obj.TextStyle
       
        ' first page the text in a dummy shape and remove style
        Set dummy = ActiveWindow.Page.DrawRectangle(1, 1, 2, 2)
        dummy.Characters.Paste
        dummy.TextStyle = ""
        
        'if text has been selected paste it into the selection
        ActiveWindow.SelectedText.Text = dummy.Text
        'obj.TextStyleKeepFmt = oldStyle
        dummy.Delete
    Else
        ActivePage.PasteSpecial (visPasteText)
    End If
End Sub

Copy page to other document

This macro allows you to copy a page to another open document. It uses a form which can be found in this zipfile...

Public Sub CopyPageToDoc()
    
    Dim currPage As Visio.Page
    Dim newPage As Visio.Page
    Dim maxNr As Integer
    Dim currBackPage As String
    Dim currPageName As String
    Dim allShapes As Visio.Selection
    Dim groupedShapes As Visio.Shape
    
    ' Group all shapes on the current page and copy them to clipboard
    ActiveWindow.SelectAll
    Set allShapes = ActiveWindow.Selection
    Set groupedShapes = allShapes.Group
    groupedShapes.Copy visCopyPasteNoTranslate
    groupedShapes.Ungroup
    ActiveWindow.DeselectAll


    ' Select the document to copy to
    Dim i As Integer
    Dim docObj As Visio.Document

    ufCopyPage.lb_docs.Clear

    For i = 1 To Documents.Count
        'Get next open document
        Set docObj = Documents.Item(i)
        'Add its name to the list box
        ufCopyPage.lb_docs.AddItem docObj.Name
    Next i
    ufCopyPage.Show
End Sub

When you select an open document in the form the real copying is being done in the next function:

Public Sub copyPageToDoc2(destDocName)
    'Get the destination document
    Set destDocObj = Documents.Item(destDocName)
    ' Create the new page
    
    Set currPage = ActivePage
    Set newPage = destDocObj.Pages.Add
    
    ' Create a proper name for the new page
    currPageName = currPage.Name
    newPage.Name = currPageName
    
    'Paste the grouped shapes
    newPage.Paste visCopyPasteNoTranslate
    If newPage.Shapes.Count Then
        newPage.Shapes.Item(1).Ungroup
    End If
    ActiveWindow.DeselectAll        
End Sub

Copy/page in place

These two macros will allow you to copy and paste elements in place, so Visio will not move them to another location when you paste them. You have to use them together because otherwise it doesn't work...

Public Sub CopyNoTranslate()
    Application.ActiveWindow.Selection.Copy (visCopyPasteNoTranslate)
End Sub
 
Public Sub PasteNoTranslate()
    Application.ActivePage.Paste (visCopyPasteNoTranslate)
End Sub

Create table of contents

Create a table of contents list. If you want to control the output you'll have to tweak the macro manually....sorry.

Public Sub CreateTableOfContents()

' creates a shape for each page in the drawing on the first page of the
' drawing then adds a hyperlink to each shape so you can click and go
' to that page

Dim TOCEntry As Visio.Shape
Dim PageToIndex As Visio.Page
Dim X As Integer
Dim StartX, StartY, TocWidth As Integer
Dim TocLineHeight As Double
Dim hlink As Visio.Hyperlink
Dim PageCnt As Double

' Set initial position and width and height. Change these values to adjust appearance
StartX = 2
StartY = 4
TocWidth = 7.5
TocLineHeight = 0.2

' Count all foreground pages
PageCnt = 0
For Each PageObj In ActiveDocument.Pages
    If PageObj.Background = False Then PageCnt = PageCnt + 1
Next

' loop through all the pages you have
For Each PageToIndex In Application.ActiveDocument.Pages

  ' you may want to refine this and use a top down algorithm with
  ' something smaller than 1 inch increments.
  X = PageToIndex.Index

    If (PageToIndex.Background = False) Then
    
        ' draw a rectangle for each page to hold the text
        Set TOCEntry = ActivePage.DrawRectangle(StartX,StartY+((PageCnt-X+1)* 
	    TocLineHeight),StartX+TocWidth, StartY+((PageCnt-X)*TocLineHeight))

        ' write the page name in the rectangle
        TOCEntry.Text = PageToIndex.Name + Chr(9) + Str(X)
        TOCEntry.TextStyle = "Normal"
        TOCEntry.LineStyle = "Text Only"
        TOCEntry.FillStyle = "Text Only"
        TOCEntry.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = "0"
        
        ' add tab stops
        TOCEntry.RowType(visSectionTab, visRowTab) = VisRowTags.visTagTab10
        TOCEntry.CellsSRC(visSectionTab, 0, visTabStopCount).FormulaU = "1"
        TOCEntry.CellsSRC(visSectionTab, 0, visTabPos).FormulaU = "131 mm"
        TOCEntry.CellsSRC(visSectionTab, 0, visTabAlign).FormulaU = "2"
          
        ' need to create a handle to add the hyperlink
        Set hlink = TOCEntry.AddHyperlink

        ' add a description
        hlink.Description = PageToIndex.Name

        ' add the page name as an address
        hlink.SubAddress = PageToIndex.Name
    End If
    
Next

End Sub