ExcelMacroFindInWord

' ExcelMacroFindInWord, sgrodnik, v1, 2024/05/22
' Descripción: https://gist.github.com/sgrodnik/e1cb245efea342666bcff6914876fa9c

Sub FindInWord()
    ' Declare variables
    Dim cell As Range
    Dim cellText As String
    Dim words As Variant
    Dim lastWord As String
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim wdRange As Object
    Dim wordFound As Boolean

    ' Capture error if there is no active cell
    On Error Resume Next
    Set cell = Application.ActiveCell
    On Error GoTo 0

    ' Check if there is an active cell
    If cell Is Nothing Then
        MsgBox "Select a cell", vbExclamation
        Exit Sub
    End If

    ' Get the text of the active cell, Check if the cell is empty
    cellText = cell.Value
    If Len(cellText) = 0 Then
        MsgBox "The cell is empty.", vbExclamation
        Exit Sub
    End If

    ' Split the text into words and get the last word
    words = Split(cellText, " ")
    lastWord = words(UBound(words))

    ' Connect to the open Word document
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0

    ' Check if the Word application is open
    If wdApp Is Nothing Then
        MsgBox "Open a Word document first", vbExclamation
        Exit Sub
    End If

    Set wdDoc = wdApp.ActiveDocument

    ' Find the last word in the Word document
    Set wdRange = wdDoc.Content
    With wdRange.Find
        .Text = lastWord
        .MatchCase = False
        .MatchWholeWord = True
        wordFound = .Execute
        If wordFound Then
            ' Activate Word and scroll to the found word
            wdApp.Activate
            wdRange.Select
            wdRange.Application.ActiveWindow.ScrollIntoView wdRange, True
        End If
    End With

    ' Show message if word was not found
    If Not wordFound Then
        MsgBox "The ID '" & lastWord & "' was not found in the document", vbExclamation
    End If
    
End Sub

Descripción en español

El macro está diseñado para trabajar con colisiones, IDs de elementos exportados desde Revit. Este script de VBA en Excel permite buscar la última palabra de una celda activa en un documento de Word abierto. Primero, verifica si hay una celda activa seleccionada en Excel y si contiene texto. Luego, se conecta a la aplicación de Word y al documento activo. Busca la última palabra del texto de la celda en el documento de Word. Si encuentra la palabra, activa Word y desplaza el documento hasta esa palabra. Si no la encuentra, muestra un mensaje indicando que la palabra no se encontró.

Description in English

The macro is designed to work with collisions, element IDs exported from Revit. This VBA script in Excel allows you to search for the last word of an active cell in an open Word document. First, it checks if there is an active cell selected in Excel and if it contains text. Then, it connects to the Word application and the active document. It searches for the last word of the cell's text in the Word document. If it finds the word, it activates Word and scrolls the document to that word. If it doesn't find the word, it displays a message indicating that the word was not found.

Instrucciones para ejecutar el código

1. Abra Excel.
2. Presione ALT + F11 para abrir el Editor de Visual Basic para Aplicaciones (VBA).
3. En el editor, inserte un nuevo módulo:
   Vaya a Insertar > Módulo.
4. Copie y pegue el código proporcionado en el módulo recién creado.
5. Cierre el Editor de VBA y vuelva a Excel.
6. Seleccione una celda que contenga texto en su hoja de cálculo.
7. Asegúrese de tener un documento de Word abierto.
8. Presione ALT + F8 para abrir la ventana Macros.
9. Seleccione FindInWord y haga clic en Ejecutar.