获取段落号找到txt，并使用Word 2010 vba将文本移动到段落结尾 [英] Get paragraph no where txt is found, and move text to end of paragraph using Word 2010 vba

问题描述

我试图用VBA将出现在各段落开头的富文本子句（strText）移动到子句出现的每个段落的末尾，然后用下划线strText。 >

我是vba编程的新手/爱好者，所以请温和。

我试过的代码有问题（如下所示）：

ol>

我试图给varLparaNo分配找到的文本（strText）出现的段落号。但是LparaNo返回的数字完全是基数。
如果有人有关于如何得到正确的段数的建议，我会很感激。
我的目的是设置一个范围变量objRange_ParaHoldingText = ActiveDocument.Paragraphs（LparaNo）.Range，即一个范围，它可以反映找到的文本的段落。

$ b

我无法弄清楚如何将objRange01（strText，这是格式化的文本）移动到它出现的段落的末尾。

任何建议都将非常感谢。

谢谢，Marc

  Sub subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_03（）
 
'Code canniablized from http://stackoverflow.com/questions/11733766/how-to-search-for 
 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 =伪造45 C.F.R. （160）和6891（a）（2）：
 
我的目标是：（1）将strText从各段开头移到每个段落出现在
之后，（2）在strText结尾删除：，（3）给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 
 
虽然c.Find.Found 
 c.Select'我正在尝试选择找到的文本
 
 Set objRange01 = c'我想要设置objRange01 =找到的文本，并选择
选择n.EndOf单位：= wdParagraph，Extend：= wdExtend'我扩展选择包括整个段落
 Set objRange02 = Selection.Range'整个段落
 Set objRange03 = ActiveDocument.Range（Start： = 0，End：= Selection.End）'我试图设置objRange02 =所有文本从
'开始doc通过objRange01.text 
 LparaNo = objRange03.ComputeStatistics（wdStatisticParagraphs）+ 1'我我试图设置LparaNo =不。从doc开头到objRange02结尾的所有
文本的段落。 
唉，为LparaNo生成的数字是不正确的。为LparaNo
生成的段落号码是在objRange01.text之前出现5个段落的段落号码。b 
 $ b MsgBoxParagraph＃& 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'& _ 
 $ b objRange01.Move单位：= wdParagraph，Count：= 1'我试图将选定的文本移动到下一段
 objRange01的开始部分
''，失败。移动单位：= wdCharacter，Count：=  -  1'我试图将选中的文本从下一段落的开始
'移动到前一段落的末尾，即
' 到所选文本的原始段落的末尾。 
 c.Find.Execute 
 
 Wend'While c.Find.Found 
 
 End With 
 
 End Sub'subFindTextAndMoveItToEndOfTheSameParagraphAndUnderlineIt_03 
  

解决方案

这是一个不使用Find的建议。如果你想使用查找，你需要循环，如果有任何风险找到相同的文本不止一次，这可能会很棘手。相反，我的解决方案通过Paragraphs集合进行循环。

pre $ b $ sub $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ $ 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 =伪造45 CFR§& Chr（160）& 6891（a）（2）：
Dim i As Long
设置一个表示该段落的计数器。这应该是足够的，
'除非你的文件是复杂的，我无法预测。
i = 0

'循环显示活动文档中的段落。
对于每个currPara在docRng.Paragraphs
i = i + 1
'检查每个段落是否匹配到strText。通过使用Mid，可以消除在文本中其他位置找到字符串的
'的机会。这将工作
'为不同的strText值。
如果Mid（currPara.Range.Text，1，Len（strText））= strText则
Set currRng = currDoc.Range（currPara.Range.Start，currPara.Range.End）
'在段落末尾添加一个空格。如果你不需要这个空间，
'只需要删除InsertAfter方法。 MoveEnd用于在段落标记之前引入
'范围的结尾。
使用currRng
.MoveEnd单位：= wdCharacter，Count：= - 1
.InsertAfter
End With
Set strRng = currDoc.Range（currRng.Start ，currRng.Start + Len（strText））
'为字符串设置一个范围，下划线，剪切，粘贴在
段落的末尾（同样在段落标记之前），并选择它。请注意，移动
'范围不会移动文本。剪切和粘贴做到这一点。
with strRng
.Underline = wdUnderlineSingle
.Cut
。移动单位：= wdParagraph，Count：= 1
。移动单位：= wdCharacter，Count：= - 1
。粘贴
。选择
以
结束结束将文本和退格三次折叠到
'去掉冒号和两个空格。如果这些最后的字符是可变的，你会
'想要比这个更好的东西。
With Selection
.Collapse wdCollapseEnd
.TypeBackspace
.TypeBackspace
.TypeBackspace
End With
'扩大我们使用的范围以保持该段落，使其包括新的
'粘贴文本。
currRng.Expand wdParagraph
'我不完全确定你想在你的消息框中传达什么。这将显示
'段落号码和段落的新文本。
MsgBoxParagraph＃&我& [currRng.Text =]& Chr（34）& currRng.Text
结束如果
下一个currPara

结束小组

I am trying to use VBA to move a rich text clause ("strText"), which appears at the beginning of various paragraphs, to the end of each paragraph where the clause appears, and thereafter to underline strText.

I am a novice/hobbyist at vba programming, so please be gentle. I spent a few days on this before seeking help.

Problems with my attempted coding (which appears below):

1. I tried to assign to var "LparaNo" the number of the paragraph wherein the found text (strText) appears. But the number that "LparaNo" returns is totally off base. If someone has a suggestion about how to get the right paragraph number, I'd appreciate it. My intention is to set a range variable objRange_ParaHoldingText= ActiveDocument.Paragraphs(LparaNo).Range, i.e., a range that would reflect the paragraph in which the sought text was found.

2. I can't figure out how to move objRange01 ("strText", which is formatted text) to the end of the paragraph in which it appears.

Any suggestions would be much appreciated.

Thanks, Marc

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

解决方案

Here is a suggestion that doesn't use Find. If you want to use Find, you'll need to loop, which can be tricky if there's any risk of finding the same text more than once. Instead, my solution loops through the Paragraphs collection. Does this get at what you're after?

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

这篇关于获取段落号找到txt，并使用Word 2010 vba将文本移动到段落结尾的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！