2012-11-28 10 views
1

VBA를 사용하여 여러 단락의 시작 부분에 나타나는 서식있는 텍스트 절 ("strText")을 이동하려고합니다. 절이 나타나는 각 단락의 끝, 그리고 나서 strText에 밑줄을 긋기.txt가있는 단락을 가져오고 Word 2010 vba를 사용하여 단락 끝으로 텍스트를 이동하십시오.

저는 VBA 프로그래밍의 초심자/애호가입니다. 따라서 부드럽게 행동하십시오. 나는 도움을 청하기 전에 며칠을 보냈다. (아래 표시) 내 코딩을 시도한와

문제 : 나는 "LparaNo"찾은 텍스트 (strText)을 표시 상기 문단의 수 VAR에 할당하려고

  1. . 그러나 "LparaNo"가 반환하는 숫자는 완전히 근본적으로 다릅니다. 누군가가 올바른 단락 번호를 얻는 방법에 대한 제안을 가지고 있다면, 고맙겠습니다. 내 의도는 범위 변수 objRange_ParaHoldingText = ActiveDocument.Paragraphs (LparaNo). 범위를 설정하는 것입니다. 범위는 검색된 텍스트가 발견 된 단락을 반영하는 범위입니다.

  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 

답변

0

여기 찾기 사용하지 않는 제안이다. 찾기를 사용하려면 동일한 텍스트를 두 번 이상 발견 할 위험이있는 경우 반복 할 필요가 있습니다. 대신 내 솔루션은 단락 컬렉션을 반복합니다. 이 일이 당신이 겪은 일에 달렸습니까?

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