Excel to Visio - Shape text color

[Cmcole]

I am creating a Visio diagram from the data in excel with VBA. My data has a column of names and a second column of addresses. I am able to drop the shapes into Visio and specify the shape (circle, square, etc) based on the name. I am able to put the name on the shape text. I need to change the color of the text. Even perhaps control bold, italics settings. I keep running across the same code examples from Visio discussion boards:

Dim vsoShape As Visio.Shape
Dim vsoCharacters As Visio.Characters
Dim vsoString As String

Set vsoCharacters = vsoShape.Characters
Dim vsoCharacters1 As Visio.Characters
vsoString = vsoShape.Characters
vsoString.CharProps(visCharacterColor) = 0#

i can’t get anything like this to work from excel.

can anyone help?

 

[pbornemeier]

Sub VisioFromExcel()

    Dim appVisio As Object
    Dim oCharacters As Object
    Dim lX As Long
    Dim sChar As String
    
    Const visSectionCharacter As Long = 3
    Const visCharacterColor  As Long = 1
    Const visCharacterStyle  As Long = 2
    Const visCharacterSize As Long = 7
    
    Set appVisio = CreateObject("visio.application")
    appVisio.Visible = True
    
    For lX = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    
        appVisio.Documents.AddEx "block_u.vst", 0, 0
        appVisio.Windows.ItemEx(lX).Activate
        appVisio.ActiveWindow.Page.Drop appVisio.Documents.Item("BLOCK_U.VSS").Masters.ItemU("Box"), 1.35, 9.8
        appVisio.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(3, 0, 7).FormulaU = "20 pt" '(visSectionCharacter,0,visCharacterSize)
        
        Set oCharacters = appVisio.ActiveWindow.Page.Shapes.ItemFromID(1).Characters
        oCharacters.Begin = 0
        oCharacters.End = Len(oCharacters)
        sChar = Cells(lX, 1).Value
        With oCharacters
            .Text = sChar
            .CharProps(visCharacterSize) = 24       'Font Size      'Works
            .CharProps(visCharacterStyle) = 0#      'Bold           'Does not work
            .CharProps(visCharacterColor) = 255#    'Color          'Does not work
        End With

        'These work, but can't be stepped through ??
        appVisio.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionCharacter, 0, visCharacterColor).FormulaU = "THEMEGUARD(RGB(255,0,0))"  'Red
        appVisio.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"  'Bold

    Next
    
    Set oCharacters = Nothing
    Set appVisio = Nothing
    
End Sub