The topics and needs to work with shape text and selecting shapes comes up quite often. So, this post tries to address these issues by giving examples of VBA syntax. Hopefully, there will be more contributions than the initial offerings that I present here. I'm attaching a file and posting the code for those who just want to copy/paste.
There are half a dozen subs. Some of the subs have two or more code methods. The topics include copying some or all text, catenating text from various shapes, pasting/replacing all or parts of text. In addition, there are multiple ways to select / use shapes, both individually and iterate thru a collection of shapes. The focus is mainly syntax, which can be modified for specific needs.
This is by no means an exhaustive treatment of these topics, but, provides starting point examples.
Enjoy!
Wapperdude
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)
Next
Next
End Sub
Sub TxtPaste()
'Note, assumes sheet.1 is the desired shape.
Dim vsoCharacters1 As Visio.Characters
Dim vsoCharacters2 As Visio.Characters
'Define text for copying:
Set vsoCharacters1 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters
vsoCharacters1.Begin = 8
vsoCharacters1.End = 14
vsoCharacters1.Copy
'Define new text location and paste old text:
Set vsoCharacters2 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters
vsoCharacters2.Begin = 24
vsoCharacters2.End = 31
vsoCharacters2.Paste
End Sub
Sub TxtPaste2()
'Note, assumes sheet.1 is the desired shape.
Dim vsoCharacters1 As Visio.Characters
Dim vsoCharacters2 As Visio.Characters
'Define text for copying:
Set vsoCharacters1 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters
vsoCharacters1.Begin = 8
vsoCharacters1.End = 14
vsoCharacters1.Copy
'Make selected shape the active shape for text pasting:
Set vsoShp = ActivePage.Shapes.ItemFromID(1)
ActiveWindow.Select vsoShp, visSelect 'This makes the shape ACTIVE
'Define new text location and paste old text:
Set vsoCharacters2 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters
vsoCharacters2.Begin = 24
vsoCharacters2.End = 31
ActiveWindow.SelectedText = vsoCharacters2
ActiveWindow.SelectedText.Paste
End Sub
Sub selShp()
'Various code techniques to select a shape.
'Shows the syntax needed.
'Uncomment or copy / modify the desired method as needed.
Dim vsoShp As Shape
'Manually preSelected:
' Set vsoShp = ActiveWindow.Selection(1)
' Debug.Print vsoShp
'Based upon ID:
' Set vsoShp = ActivePage.Shapes.ItemFromID(1)
' ActiveWindow.Select vsoShp, visSelect 'This makes the shape ACTIVE
' Debug.Print vsoShp
'Following methods are for stepping thru multiple shapes on a page.
'The 1st is good for deleting shapes, but you MUST progress from highest ID to lowest.
'Thus, the FOR statement would be:
'For i = shpCnt To 1 Step -1
'Method1:
' shpCnt = ActivePage.Shapes.Count
' For i = 1 To shpCnt Step 1
' Set vsoShp = ActivePage.Shapes.ItemU(i)
' Debug.Print vsoShp
' Next
'or Method2:
' For Each vsoShp In ActivePage.Shapes 'Checks every shape on each page
' Debug.Print vsoShp
' Next
End Sub
Sub CatNRpl()
'This macro copies all text from shapes 1 - 3
'Catenates the 3 text strings and pastes into shape 4.
'
Dim shpChrs1 As Visio.Characters
Dim shpChrs2 As Visio.Characters
Dim shpChrs3 As Visio.Characters
Dim shpChrs4 As Visio.Characters
Set shpChrs1 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters
Set shpChrs2 = ActiveWindow.Page.Shapes.ItemFromID(2).Characters
Set shpChrs3 = ActiveWindow.Page.Shapes.ItemFromID(3).Characters
Set shpChrs4 = ActiveWindow.Page.Shapes.ItemFromID(4).Characters
shpChrs4 = shpChrs1 & Chr(10) & shpChrs2 & Chr(10) & shpChrs3
End Sub
Sub CatNRpl2()
'Alternate technique, same amount of coding
'This macro copies all text from shapes 1 - 3
'Catenates the 3 text strings and pastes into shape 4.
'
Dim shpChrs1 As Visio.Characters
Dim shpChrs2 As Visio.Characters
Dim shpChrs3 As Visio.Characters
Dim vsoShp As Visio.Shape
Set shpChrs1 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters
Set shpChrs2 = ActiveWindow.Page.Shapes.ItemFromID(2).Characters
Set shpChrs3 = ActiveWindow.Page.Shapes.ItemFromID(3).Characters
Set vsoShp = ActivePage.Shapes.ItemFromID(4)
' ActiveWindow.Select vsoShp, visSelect 'Optional: this makes the shape ACTIVE
vsoShp.Text = shpChrs1.Text & Chr(10) & shpChrs2.Text & Chr(10) & shpChrs3.Text
End Sub