Rename visio

[Rafaelete]

Hello,

I have been searching for a way to replace inside words inside a visio using the information within two columns in excel. The columns are in the excel that has the macro, Sheet name: "Intro", the columns are: Column B: Original words, Column C: Words to be replaced.
I have been able to do it, but the code runs to each sheet in visio, one by one. But I want it to do a replace all to run faster, I have seen that visio has an option to replace in all pages at once. Any ideas on how to do that will be greatly appreciated:

-Excel columns:

- Visio:

Is currently chainging the information in a bunch of visios that are inside subfolders. As you can see, in this examples, it has your sheets, is going through each, one by one. There is an option in visio to find, replace in all pages. I need to get it to work here as well because is taking a long time replacing each visio. Thanks a lot.

On Error GoTo CambiarTextoEnFicheroVisio_Error

Dim aVisio As Object ' Visio.Application
Dim aDocument As Object ' Visio.Document
Dim i As Integer
Dim iBegin As Integer
Dim iPage As Integer
Dim iTextosASustituir As Integer
Dim sFileNamePdf As String
Dim sAux As String


' Obtener documento
Set aVisio = CreateObject("Visio.Application")

' Set aDocument = aVisio.Documents.OpenEx("path used", Flags:=Visio.visOpenRW)
Set aDocument = aVisio.Documents.OpenEx("path used", Flags:=visOpenRW)


' Recorrerse todas las páginas
For iPage = 1 To aVisio.ActiveDocument.Pages.Count

aVisio.ActiveWindow.Page = aVisio.ActiveDocument.Pages(iPage)

' Recorrerse todas las formas
For i = 1 To aVisio.ActiveWindow.Page.Shapes.Count

' Modificar todos los textos
For iTextosASustituir = 1 To colTextosOriginales.Count
' Dim vsoCharacters As Visio.Characters
Dim vsoCharacters As Object

Set vsoCharacters = aVisio.ActiveWindow.Page.Shapes(i).Characters
iBegin = InStr(1, vsoCharacters.Text, colTextosOriginales.Item(iTextosASustituir))

If iBegin > 0 Then
iBegin = iBegin - 1 ' En visio para sustituir hay que situarse uno por detrás
vsoCharacters.Begin = iBegin
vsoCharacters.End = vsoCharacters.Begin + Len(colTextosOriginales.Item(iTextosASustituir))
vsoCharacters.Text = colTextosFinales.Item(iTextosASustituir)
End If
Next iTextosASustituir
Next i
Next iPage

aDocument.SaveAs CambiarNombreFichero("path used")

'Imprimir en Pdf
If bExportarPdF Then
sAux = CambiarNombreFichero("path used")
sFileNamePdf = CambiarNombreFicheroAPdF(sAux)

' aVisio.ActiveDocument.ExportAsFixedFormat Visio.visFixedFormatPDF, sFileNamePdf, Visio.visDocExIntentPrint, Visio.visPrintAll, 1, aVisio.ActiveDocument.Pages.Count, False, True, True, True, False
aVisio.ActiveDocument.ExportAsFixedFormat visFixedFormatPDF, sFileNamePdf, visDocExIntentPrint, visPrintAll, 1, aVisio.ActiveDocument.Pages.Count, False, True, True, True, False
End If

aDocument.Close
aVisio.Quit
Set aVisio = Nothing