Excel to Visio - Shape text color

Cmcole

New Member
Joined
Nov 4, 2019
Messages
1
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?





 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top