Shape text search and replace

Started by UHJ, February 25, 2020, 10:43:32 AM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

UHJ

I have some shapes I created and added a few shape text fields.
Now I find I need to replace some of the text in the shapes. Basically all shapes with text like "SCADA Manual", I need to replace "SCADA" with "SRO" on client's request.
When using the crtl+h search and replace function, it finds the text to replace nicely but it replces the full text despite. So instead of "SRO Manual" I only get "SRO"
What am I doing wrong here?

Nikolay

Visio search and replace does not replace in fields. It only replaces in shape text, as far as I know.
If you use fields, you could use a macro for example.

UHJ

Thanks, Nikolay.
I will consider if the number of replacements warrant me spending time creating a macro for this.
It is great that you could confirm my suspicion, that field texts cannot be partially replaced only completely. I thought I as doing something wrong, but I could not figure out what it could be.

Nikolay

If the text is a part of a regular shape text (not an inserted field) then it is replaced normally (i.e. partially)

Yacine

Sub replace_in_fields()

    Dim rep_what As String, rep_by As String, rep_where As String
    Dim shp As Shape

    rep_what = InputBox("What do you want to replace?")
    rep_by = InputBox("By what do you want to replace it?")
    rep_where = InputBox("In which field do you want the replacement? (Use shapesheet notation)")
   
    If rep_what = "" Or rep_by = "" Or rep_where = "" Then Exit Sub
   
    For Each shp In ActivePage.Shapes
        If shp.CellExists(rep_where, visExistsAnywhere) Then
            shp.Cells(rep_where).Formula = Chr(34) & replace(shp.Cells(rep_where).ResultStr(""), rep_what, rep_by) & Chr(34)
        End If
    Next shp

End Sub
;)
Yacine

wapperdude

#5
In the shapesheet, there is the Substitute fcn:  https://docs.microsoft.com/en-us/office/client-developer/visio/substitute-function

See also these functions:  Left, Right, Len.  There might be one or two more related to working with text from within shapesheet.

Here's forum discussion on selecting / working with text:  http://visguy.com/vgforum/index.php?topic=7638.msg32400#msg32400

And then, here're other macros related to text:


Sub ChgText()
    Dim vsoPage As Visio.Page, vsoShape As Visio.Shape
    Dim vsoCharacters1 As Visio.Characters, vsoStrng As String, vsoMyText As String
    'vsoMyText = "NewText"
    'vsoMyText = Chr(34) & vsoMyText & Chr(34)
   
    For Each vsoPage In ThisDocument.Pages
        For Each vsoShape In vsoPage.Shapes
            Set vsoCharacters1 = vsoShape.Characters
            'vsoStrng = vsoCharacters1.Text                  'This step not necessary, vsoCharacters1.Text could be placed directly in the formula on the next line.
            'vsoCharacters1.Text = Replace(vsoStrng, "MyText", vsoMyText)
    If vsoCharacters1 = "AAA" then
Msgbox "Found AAA Shape"
    endif
        Next
    Next
End Sub


And then this searches for part of text, and makes it bold, but could be modified to do a replacement instead:

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
Visio 2019 Pro