Получить абзац, где находится текстовый файл, и переместить текст в конец абзаца с помощью Word 2010 vba

Я пытаюсь использовать VBA, чтобы переместить предложение отформатированного текста ("strText"), которое появляется в начале различных абзацев, в конец каждого абзаца, где это предложение появляется, а затем для подчеркивания strText.

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

Проблемы с моей попыткой кодирования (которая отображается ниже):

  1. Я попытался присвоить var "LparaNo" номер абзаца, в котором появляется найденный текст (strText). Но число, которое возвращает "LparaNo", совершенно не соответствует действительности. Если у кого-то есть предложение о том, как получить правильный номер абзаца, я буду признателен. Я намерен установить переменную диапазона objRange_ParaHoldingText = ActiveDocument.Paragraphs (LparaNo) .Range, то есть диапазон, который будет отражать абзац, в котором был найден искомый текст.

  2. Я не могу понять, как переместить objRange01 («strText», форматированный текст) в конец абзаца, в котором он появляется.

Любые предложения будут высоко ценится.

Спасибо, Марк

Sub subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_03()

    ' Code canniablized from http://stackoverflow.com/questions/11733766/how-to-search-for-text-and-check-for-underline-in-vba-for-word
    Dim c As Range
    Dim fnd As String
    Dim strText As String
    Dim objRange01 As Range
    Dim objRange02 As Range
    Dim objRange03 As Range
    Dim LparaNo As Long
    Dim strParazText As String


    With ActiveDocument

        strText = "Falsification  45 C.F.R. §" & Chr(160) & "6891(a)(2):  "

        ' My objectives are: (1) to move strText from the beginning of various paragraphs, to the end of each paragraph where it appears,
        '    and thereafter, (2) to delete the ":" at the end of strText, and (3) to underline strText

        fnd = strText

        If fnd = "" Then Exit Sub

        Set c = ActiveDocument.Content

        c.Find.ClearFormatting
        c.Find.Replacement.ClearFormatting

        With c.Find
            .Text = fnd
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindStop
        End With

        c.Find.Execute

        While c.Find.Found
            c.Select ' I am trying to select the text that was found

            Set objRange01 = c ' I am trying to set objRange01 = the text that was found, and selected
            Selection.EndOf Unit:=wdParagraph, Extend:=wdExtend ' I am extending the selection to include the entire paragraph
            Set objRange02 = Selection.Range 'The entire paragraph
            Set objRange03 = ActiveDocument.Range(Start:=0, End:=Selection.End) ' I am trying to set objRange02 = all text from
            '                                                                     '   beginning of doc thru objRange01.text
            LparaNo = objRange03.ComputeStatistics(wdStatisticParagraphs) + 1 ' I am trying to set LparaNo = the no. of paras in all
            '                                                                 '    text from beginning of doc thru the end of objRange02.
            '                  ' Alas, the number generated for "LparaNo" is incorrect. The paragraph number generated for "LparaNo"
            '                  '    is the number for a paragraph that appears 5 pages before objRange01.text

            MsgBox "Paragraph # " & LparaNo & "  [objRange01.Text = c = ]  " & Chr(34) & objRange01.Text & Chr(34) & vbCrLf & _
                    vbCrLf & objRange02.Text & vbCrLf & vbCrLf & _
                    ActiveDocument.Paragraphs(LparaNo - 2).Range.Text & vbCrLf & _
                    ActiveDocument.Paragraphs(LparaNo - 1).Range.Text & vbCrLf & _
                    ActiveDocument.Paragraphs(LparaNo).Range.Text & vbCrLf ' & _
'                    ActiveDocument.Paragraphs(LparaNo + 1).Text & vbCrLf & _
'                    ActiveDocument.Paragraphs(LparaNo + 2).Range.Text & vbCrLf '& _

            objRange01.Move Unit:=wdParagraph, Count:=1 ' I am trying unsuccessfully to move the selected text to the beginning
            '                                            '   of the next paragraph
            objRange01.Move Unit:=wdCharacter, Count:=-1 ' I am trying unsuccessfully to move the selected text from the beginning
            '                                            '   of the next paragraph, to the end of the preceding paragraph, i.e.,
            '                                            '   to the end of the selected text's paragraph of origin.
            c.Find.Execute

        Wend ' While c.Find.Found

    End With

End Sub 'subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_03

find vba ms-word word-automation textrange
person Marc B. Hankin    schedule 28.11.2012    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Вот предложение, которое не использует Find. Если вы хотите использовать Find, вам нужно будет выполнить цикл, что может быть сложно, если есть риск найти один и тот же текст более одного раза. Вместо этого мое решение проходит через коллекцию Paragraphs. Это касается того, что вам нужно?

Sub subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_04()
Dim currDoc As Document
Set currDoc = ActiveDocument
Dim docRng As Range, currRng As Range, strRng As Range
Set docRng = ActiveDocument.Content
Dim currPara As Paragraph
Dim strText As String
strText = "Falsification  45 C.F.R. §" & Chr(160) & "6891(a)(2):  "
Dim i As Long
' Set a counter to indicate the paragraph. This should be sufficient,
' unless your document is complicated in a way I cannot predict.
i = 0

' Loop through the paragraphs in the active document.
For Each currPara In docRng.Paragraphs
    i = i + 1
    ' Check each paragraph for a match to strText. By using Mid you eliminate
    ' the chance of finding the string somewhere else in the text. This will work
    ' for different strText values.
    If Mid(currPara.Range.Text, 1, Len(strText)) = strText Then
        Set currRng = currDoc.Range(currPara.Range.Start, currPara.Range.End)
        ' Adds a space at the end of the paragraph. If you don't want the space,
        ' just delete the InsertAfter method. MoveEnd is used to bring the end of the
        ' range before the paragraph marker.
        With currRng
            .MoveEnd Unit:=wdCharacter, Count:=-1
            .InsertAfter " "
        End With
        Set strRng = currDoc.Range(currRng.Start, currRng.Start + Len(strText))
        ' Set a range for the string, underline it, cut it, paste it at the end of the
        ' paragraph (again, before the paragraph marker), and select it. Note that moving
        ' a range doesn't move the text in it. Cut and paste does that.
        With strRng
            .Underline = wdUnderlineSingle
            .Cut
            .Move Unit:=wdParagraph, Count:=1
            .Move Unit:=wdCharacter, Count:=-1
            .Paste
            .Select
        End With
        ' Collapse the selection to the end of the text and backspace three times to
        ' remove the colon and two spaces. If these final characters are variable, you'll
        ' want something spiffier than this.
        With Selection
            .Collapse wdCollapseEnd
            .TypeBackspace
            .TypeBackspace
            .TypeBackspace
        End With
        ' Expand the range we've been using to hold the paragraph so that it includes the newly
        ' pasted text.
        currRng.Expand wdParagraph
        ' I wasn't entirely sure what you wanted to convey in your message box. This displays
        ' the paragraph number and the new text of the paragraph.
        MsgBox "Paragraph # " & i & "  [currRng.Text = ]  " & Chr(34) & currRng.Text
    End If
Next currPara

End Sub
person Christina    schedule 20.12.2012