Macro para ubicarse en un texto buscado, de un documento de varias paginas y reemplazarlo por un nuevo texto que corresponde a una lista de imagenes

Question

Buenos días a todos, en primer lugar agradezco las respuestas:

Tengo una macro para WORD, que deseo que luego de encontrar un texto especifico, se posiciones en la ubicación donde se encuentre el texto buscado, para poder reemplazarlo, que corresponde a una lista de varios textos a reemplazar que corresponde a una descripción especifica de la imagen que le corresponde, ello para describir una gran cantidad de imágenes.

Gracias de Antemano,

Aquí copio la macro:

Sub MacroDescribirImagenesDocumento()
'
' MacroContarImagenesDocumento Macro
'
'
' Acceso directo: Ctrl+Mayús+F

Dim xInlines As Long
Dim xFloaters As Long
Dim sh As Shape
Dim tbxs As Long
Dim msg As String

Dim IniImagen As Long

With ActiveDocument
For Each sh In .Shapes
If sh.Type = msoTextBox Then tbxs = tbxs + 1
Next
xInlines = .InlineShapes.Count
xFloaters = .Shapes.Count - tbxs
End With
xPrompt = "Inline images:" & vbTab & xInlines & vbCr
xPrompt = xPrompt & "Floating shapes:" & vbTab & xFloaters & vbCr
xPrompt = xPrompt & vbTab & "Total:" & vbTab & (xInlines + xFloaters) & vbCr
xPrompt = xPrompt & "Counts do not include headers and footers, etc."
MsgBox xPrompt, vbInformation, "Kutools for Word"

TotImagen = xInlines + xFloaters
IniImagen = InputBox("Ingrese desde que IMAGEN va a describirlos:", , 1)

'Bucle para validar que el IniImagen no sea mayor o igual que TotImagen
If TotImagen >= IniImagen Then

For i = IniImagen To TotImagen

    txtFind = "F" & Format(i, "00") & "_Describir"

    'Ubicarse en la posicion donde se encuentra el texto a buscarse (txtFind)
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = txtFind
        .Replacement.Text = txtFind
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With

    'Solicitar una nueva descripción de la imagen
    txtNew = InputBox("Describe la IMAGEN:", , Left(txtFind, 4))

    'Bucle que reemplaza el nuevo texto descrito para la imagen
        Selection.Find.Execute
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = txtFind
            .Replacement.Text = txtNew
            .Forward = True
            .Wrap = wdFindAsk
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With

    i = i + 1
Next i

Else
MsgBox "El TOTAL de IMAGENES es menor que la IMAGEN inicial" & vbCr & _
"Se finalizará el programa", vbInformation, "SolucionesHyZ for Word"
End If
End Sub

Gracias por la ayuda.

Answer 1

Q&A forums are currently English only. I'd try asking for help over here in dedicated forums.
https://social.msdn.microsoft.com/Forums/es-es/home
https://social.technet.microsoft.com/Forums/es-es/home
https://answers.microsoft.com/es-es

--please don't forget to upvote and Accept as answer if the reply is helpful--