Formulas that are contained in the Font cell of the Character table of a shape's ShapeSheet are replaced by values when you use Visio 2003 to open a drawing that was created in Visio 2002 or in Visio 2000 (842489)

WORKAROUND

Microsoft provides programming examples for illustration only, without warranty either expressed or implied. This includes, but is not limited to, the implied warranties of merchantability or fitness for a particular purpose. This article assumes that you are familiar with the programming language that is being demonstrated and with the tools that are used to create and to debug procedures. Microsoft support engineers can help explain the functionality of a particular procedure, but they will not modify these examples to provide added functionality or construct procedures to meet your specific requirements. To work around this issue, use custom code to programmatically import the Visio 2002 or the Visio 2000 drawing to Visio 2003 and to retain the formula that is used in the Font cell in the ShapeSheet. To do this, use the following a sample macro:

Option Explicit

Dim g_strInputFile As String
Dim g_strFontCellFormula As String
Dim g_strProtectedFontCellFormula As String
Dim g_strUserCell As String

Public Sub FixFontFormula()

Dim shapeObj As Visio.Shape
Dim docObj As Visio.Document
Dim pageObj As Visio.Page
Dim masterObj As Visio.master

' Initialize global variables

' Step 1: Set up the input file
g_strInputFile = "Drive:\PathofDrawing\DrawingName.vsd"

' Step 2: Initialize font formulas
g_strFontCellFormula = "ThePage!Prop.PageFont"
g_strProtectedFontCellFormula = "GUARD(" + g_strFontCellFormula + ")"
g_strUserCell = "Prop.PageFont"

Set docObj = Visio.Documents.Open(g_strInputFile)

' Step 3: Fix all shapes on pages
For Each pageObj In docObj.Pages
    If IsFormulaAvailable(pageObj.PageSheet) Then
        For Each shapeObj In pageObj.Shapes
            FixShape shapeObj
        Next
    End If
Next

' Step 4: Fix all masters on document stencil
For Each masterObj In docObj.Masters
    If IsFormulaAvailable(masterObj.PageSheet) Then
        For Each shapeObj In masterObj.Shapes
            FixShape shapeObj
        Next
    End If
Next

' Step 5: Fix styles as well?

End Sub

Public Function FixShape(ByRef shapeObj As Visio.Shape)
    Dim memberShapeObj As Visio.Shape
    Dim nRows As Integer
    Dim curRow As Integer
    
    nRows = shapeObj.RowCount(visSectionCharacter)
    For curRow = 0 To (nRows - 1)
        '   Update Font formula
        shapeObj.CellsSRC(visSectionCharacter, curRow, visCharacterFont).Formula = g_strProtectedFontCellFormula
        '   Optional for Asian languages - Update Font formula for Asian Font (cell not available in Visio 2002)
        shapeObj.CellsSRC(visSectionCharacter, curRow, visCharacterAsianFont).Formula = g_strProtectedFontCellFormula
    Next
    
    'Fix member shapes (in case of a group shape)
    For Each memberShapeObj In shapeObj.Shapes
        FixShape memberShapeObj
    Next

End Function

Public Function IsFormulaAvailable(ByRef shapeObj As Visio.Shape) As Boolean
    
    IsFormulaAvailable = shapeObj.CellExists(g_strUserCell, visExistsAnywhere)

End Function