Не могу найти и заменить значение в таблице в MSWord - PullRequest
Новая
       12

Не могу найти и заменить значение в таблице в MSWord

0 голосов
/ 30 апреля 2018 
Sub Macro2()

Dim x As String
Dim y As String

x = ActiveDocument.Tables(1).Rows(2).Cells(2).Range.Text
y = ActiveDocument.Tables(1).Rows(2).Cells(3).Range.Text

MsgBox x
MsgBox y

With ActiveDocument.Content.Find
 .Text = x
 .ClearFormatting
 .Forward = True
 .Execute
If .Found = True Then .Replacement.Text = y
End With

End Sub

Я пытаюсь написать небольшую программу, которая поможет моему коллеге ускорить выполнение задачи.

Вот проблема

Вот таблица, над которой я работаю. Найдите все Test 1 в документе и замените все Test 1 на Test 2.

Итак, я написал приведенный выше код, чтобы делать то, что я хочу. Однако я не знаю, где это пошло не так. Каждый раз, когда я запускаю программу, значение остается неизменным.

Если вы заметили, что у меня есть два Msgbox для определения местоположения, текст выделен правильно, я уверен, что правильно определяю ячейку.

Но я все еще не могу заменить значение.

1 Ответ

0 голосов
/ 30 апреля 2018

Я позволил себе немного «сжать» ваш код, чтобы сделать его более эффективным и легким для чтения, объявив объекты для ActiveDocument и Tables(1).

Так как также кажется, что вы хотите сделать простой поиск / замену, я изменил .Execute, чтобы сделать замену. Но если ваш код на самом деле более сложный, то вы, конечно, должны сохранить If, который есть у вас в исходном коде.

Я также добавил функцию, которую я использую, которая отсекает символы ANSI 13 и ANSI 7 от конца текста, возвращаемого ячейкой Range. Когда вы запустили свой код, вы могли заметить черную точку под надписью «Тест 1» или «Тест 2» в MsgBox? Это ANSI 7, а вертикальный интервал между текстом и точкой является меткой абзаца (ANSI 13). Они исчезают при использовании функции, и в моем тесте замена прошла успешно. 

Sub FindReplaceInTable()    
    Dim x As String
    Dim y As String
    Dim doc As word.Document
    Dim tbl As word.Table

    Set doc = ActiveDocument
    Set tbl = doc.Tables(1)
    x = TrimCellText(tbl.Rows(2).Cells(2).Range)
    y = TrimCellText(tbl.Rows(2).Cells(3).Range)

    'MsgBox x
    'MsgBox y

    With doc.content.Find
     .Text = x
     .ClearFormatting
     .Forward = True
     .Replacement.Text = y
     .Execute Replace:=wdReplaceAll
    End With
End Sub

Function TrimCellText(r As word.Range) As String
    Dim sLastChar As String
    Dim sCellText As String

    sCellText = r.Text
    sLastChar = Right(sCellText, 1)
    Do While sLastChar = Chr(7) Or sLastChar = Chr(13)
        sCellText = Left(sCellText, Len(sCellText) - 1)
        sLastChar = Right(sCellText, 1)
    Loop
    TrimCellText = sCellText
End Function
...