VBA to bold specific words

Started by bevangg, April 13, 2018, 06:15:13 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

bevangg

I am trying to write a function to search through an entire visio document and bold all instances of a particular word. I have got so far as replacing the text but the formatting has defeated me.
Anybody know if this can be done and if so how?

Sub bold()
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoCharacters1 As Visio.Characters
Dim vsoStrng As String
For Each vsoPage In ThisDocument.Pages
For Each vsoShape In vsoPage.Shapes
Set vsoCharacters1 = vsoShape.Characters
vsoStrng = vsoCharacters1.Text
vsoCharacters1.Text = Replace(vsoStrng, "Insert", "Insert in bold text")
Next
Next
End Sub

Surrogate

#1
You need find start and end positions of each instance and apply bold formatting there!
For find start position use instr function. end position equal position plus length of new text.
Use Len function for define new text length
String functions in VBA

bevangg


bevangg

Quote from: Surrogate on April 13, 2018, 07:52:46 AM
You need find start and end positions of each instance and apply bold formatting there!
For find start position use instr function. end position equal position plus length of new text.
Use Len function for define new text length
String functions in VBA

Ok, I have got as far as determining the start and end points of the string but still not sure how to use that to bold!
Sub bold()
Dim StartString As Long
Dim EndString As Long
Dim StringLength As Long
Dim vsoTobold As String
vsoTobold = "Insert in bold text"
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoCharacters1 As Visio.Characters
Dim vsoStrng As String
For Each vsoPage In ThisDocument.Pages
For Each vsoShape In vsoPage.Shapes
Set vsoCharacters1 = vsoShape.Characters
vsoStrng = vsoCharacters1.Text
StartString = InStr(vsoStrng, vsoTobold)
StringLength = Len(vsoTobold)
EndString = StartString + StringLength
vsoCharacters1.Text = Replace(vsoStrng, "Insert", "Insert in bold text")
Next
Next
End Sub

JM

#4
I believe you will need to retrieve the Characters object from the shape first:
https://msdn.microsoft.com/en-us/vba/visio-vba/articles/characters-object-visio

and then with that object, you will need to set the BEGIN and END properties of that object based on the index you have come up with with your INSTR().
Once you have set the Character's object's begin and end points, you would then manipulate the character properties via:

https://msdn.microsoft.com/en-us/vba/visio-vba/articles/characters-charprops-property-visio

to set visCharacterStyle


[Man, that is a convoluted process, but I guess it is a complex animal, with multiple formats on different parts of the text..]

Here is a test driver and a subroutine that makes it a bit easier..   You will note that I apply both bold and underline formatting.. change this as you need.

Public Sub testformat()
Dim vsoShape As Visio.Shape
Dim beginIndex As Integer
Dim endIndex As Integer
    Set vsoShape = ActiveWindow.Shape.Shapes("APP.8")
    'be sure to add error checking if the search word isn't found.. I didnt bother here
    beginIndex = InStr(1, vsoShape.Text, "uni", vbTextCompare) - 1
    endIndex = beginIndex + Len("uni")
    Call FormatShapesTextSubstring(vsoShape, beginIndex, endIndex, visCharacterStyle, visBold + visUnderLine)
   
End Sub


'pFormat values can be found in Visio type library in VisCellIndices
'E.g. visCharacterStyle   and value visBold, or visBold + visItalic + visUnderLine
Public Sub FormatShapesTextSubstring(ByRef pVsoShape As Visio.Shape, ByVal pBegin As Integer, ByVal pEnd As Integer, ByVal pFormatType As Integer, ByVal pFormat As Integer)
Dim shapeCharacter As Visio.Characters

    'Get the Characters object for the Shape.  Default call gets the text
    With pVsoShape.Characters
        'Sets the start of the portion of the text to format
        .Begin = pBegin
        'Sets the end of the portion of the textx to format
        .End = pEnd
        'Sets the format
        .CharProps(pFormatType) = pFormat
    End With
End Sub


bevangg

Thanks JM, that cracked it! Here is the working code:
Sub bold()
Dim StartString As Long
Dim EndString As Long
Dim StringLength As Long
Dim vsoTobold As String
vsoTobold = "Insert"
Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoCharacters1 As Visio.Characters
Dim vsoStrng As String
For Each vsoPage In ThisDocument.Pages
For Each vsoShape In vsoPage.Shapes
Set vsoCharacters1 = vsoShape.Characters
vsoStrng = vsoCharacters1.Text
StartString = InStr(vsoStrng, vsoTobold) - 1
StringLength = Len(vsoTobold)
EndString = StartString + StringLength
Call FormatShapesTextSubstring(vsoShape, StartString, EndString, visCharacterStyle, visBold)
Next
Next
End Sub


Public Sub FormatShapesTextSubstring(ByRef pVsoShape As Visio.Shape, ByVal pBegin As Integer, ByVal pEnd As Integer, ByVal pFormatType As Integer, ByVal pFormat As Integer)
Dim shapeCharacter As Visio.Characters
    With pVsoShape.Characters
        .Begin = pBegin
        .End = pEnd
        .CharProps(pFormatType) = pFormat
    End With
End Sub

But I am stuck again! It can only find the first instance of the target string in any shape.


wapperdude

#6
Here's simple code that I used to look for specified text in a selected shape and make it bold.  In the code below, all occurrences of the word "the" are made bold.


Sub MakeBold()
    Dim vsoShp As Visio.Shape
    Dim vsoChars As Visio.Characters
    Dim strLen As Integer
    Dim i As Integer
   
    vsoMyText = "the"   'Enter desired text.  This example finds all words = the
   
    Set vsoChars = ActiveWindow.Selection(1).Characters
    Set vsoShp = ActiveWindow.Selection(1)
   
    strLen = Len(vsoChars) - 1  'Length of entire shape text with "0" as starting count.
    txtLen = Len(vsoMyText)     'Length of desired text
   
    For i = 0 To strLen         'Loop thru entire shape text
        vsoChars.Begin = i
        vsoChars.End = i + txtLen   'Check only char strings with same desired length
        If StrComp(vsoChars.Text, vsoMyText, vbTextCompare) = 0 Then
            vsoChars.CharProps(visCharacterStyle) = 17#     'Set to bold.  This number from macro recorder.
        End If
    Next
End Sub


HTH
Wapperdude
Visio 2019 Pro