So I looked thru the site and this problem is referenced multiple times and it seems like every answer is "its somewhere on the forum" or there is a broken link so I'm re-posting, sorry to those who have seen this question before.
Does anyone have handy, code that will allow you to run a Find & Replace on Custom Property text?
Just to be clear, are you wanting to find and replace the contents of the custom property or find and replace the custom property itself?
The basic tool is the strcomp vba function. There are a lot of examples on the net. The other part of this are some nested loops...if your Visio file has multiple pages, you need to go thru each page. Then, on each page you need to loop thru all the shapes. Finally, you loop thru each shape searching the shape data section for those that meet your fine / replace criteria.
Yes, there are a lot of related items in the forum and on the net, so you need to build your code from those those various examples. I doubt anyone has done your specific case. If you've not done VBA before, or are unsure, help is available, we just need more info.
Wapperdude
Yeah just find/replacing custom property contents on a single page for multiple shapes. Each shape is basically identical just the contents of the properties change, so I can loop thru each shape easily enough, just not sure of how I would run a find/replace for its contents.
How would you provide the data for replacement? Read from a source? Have code open up shapesheet and then enter by hand? Hardcode the replacement into VBA and do and let code do it?
For example, the following untested code has hardcode entries. You enter the old value and enter the new value into the code. Save and run.
Sub FindReplaceShpData()
Dim vsoShp As Shape
Dim myNewTxt As String, OldTxt As String
Dim i As Integer
Dim nRows As Integer
OldTxt = "Enter existing string here"
myNewTxt = "Enter new text here"
For Each vsoShp In ActiveDocument.Pages(1).Shapes
If vsoShp.Master <> "Dynamic connector" Then
nRows = vsoShp.RowCount(Visio.visSectionProp) 'number of rows in Shape Properties section
For i = 0 To nRows - 1 'Search all rows for value cell = Engineer
If vsoShp.CellsSRC(Visio.visSectionProp, i, 0).ResultStr(Visio.visNoCast) = Chr(34) & OldTxt & Chr(34) Then
vsoShp.CellsSRC(Visio.visSectionProp, i, 0).FormulaForceU = Chr(34) & myNewTxt & Chr(34)
End If
Next i
End If
Next
End Sub
Wapperdude
I was going to have a userform with "find" and "replace" text boxes. I had something similar to what you've provided. The real problem I am having is trying to run it like the true find/replace feature. For instance if I had a string of text = "It is a warm and sunny day." , and I wanted to replace it with "It is a warm and cloudy day." I don't want to run a find and replace on the entire string, I would just want to enter "sunny" into FIND and "cloudy" into REPLACE. Thanks for your help so far.
For something like that, this code will work. If your shapedata had the entry: "The big, black canary." The word to replace in the string is "black". The new word will be "yellow".
Sub FindReplaceShpData()
Dim vsoShp As Shape
Dim myNewTxt As String, OldTxt As String, vsoChars1 As String
Dim i As Integer
Dim nRows As Integer
myNewTxt = "yellow"
For Each vsoShp In ThisDocument.Pages(1).Shapes
nRows = vsoShp.RowCount(Visio.visSectionProp) 'number of rows in Shape Properties section
For i = 0 To nRows - 1 'Search all rows and fetch entire content
OldTxt = vsoShp.CellsSRC(Visio.visSectionProp, i, 0).ResultStr(none)
vsoChars1 = Replace(OldTxt, "black", myNewTxt) 'Replace the word black in the string. It not found, do nothing
vsoShp.CellsSRC(Visio.visSectionProp, i, 0).FormulaForceU = Chr(34) & vsoChars1 & Chr(34) 'Re-populate the cell with the corrected string of text
Next i
Next
End Sub
Wapperdude
Yeah that worked amazingly, thanks a bunch for your help.
...,and a slightly friendlier version that makes defining the target and replacement text entries easier.
Sub FindReplaceShpData()
'Friendly version. Easier to define the "find" and "replacement" text.
'
Dim vsoShp As Shape
Dim repTxt As String, theTxt As String, fndTxt As String
Dim i As Integer
Dim nRows As Integer
fndTxt = "black"
repTxt = "yellow"
For Each vsoShp In ActiveDocument.Pages(1).Shapes
nRows = vsoShp.RowCount(Visio.visSectionProp) 'number of rows in Shape Properties section
For i = 0 To nRows - 1 'Search all rows
theTxt = Replace(vsoShp.CellsSRC(Visio.visSectionProp, i, 0).ResultStr(none), fndTxt, repTxt) 'Replace fndTxt with repTxt in the string. It not found, do nothing
vsoShp.CellsSRC(Visio.visSectionProp, i, 0).FormulaForceU = Chr(34) & theTxt & Chr(34) 'Re-populate the cell with the corrected string of text
Next i
Next
End Sub