用vba替换文本和字段中的文本

时间:2016-07-21 13:46:50

标签: vba replace word-vba

我有一个工作,但是搜索文档和搜索特定文本的方法很慢:问题" tab" A然后用文本替换它,但其中A被引用为customvariable。有没有人做过类似的事情?

Sub hsdkjgh()
    Call replaceIssueNonVariable(ActiveDocument)
End Sub

Public Function SearchInStory(ByVal rngStory As word.Range, ByVal strSearch As String) As Boolean
    SearchInStory = False
    With rngStory.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = strSearch
        .Replacement.Text = strReplace
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchWildcards = True
        .Execute
        If .found Then
            rngStory.Text = "Issue:" & vbTab & ";;;;;;"

            Call SearchInStory2(rngStory, ";;;;;;")


            SearchInStory = True


        End If
    End With
End Function

Public Function SearchInStory2(ByVal rngStory As word.Range, ByVal strSearch As String) As Boolean
    SearchInStory2 = False
    With rngStory.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = strSearch
        .Replacement.Text = strReplace
        .Wrap = wdFindContinue
        .MatchCase = False
        .MatchWildcards = True
        .Execute
        If .found Then
            rngStory.Select
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDocProperty, Text:="_DocumentIssue", PreserveFormatting:=True
            SearchInStory2 = True


        End If
    End With
End Function

Sub replaceIssueNonVariable(doc As Document)

    Dim temp As Variant
    Dim pFindTxtArray(4) As String
    Dim pReplaceTxtArray(4) As String


    pReplaceTxt = "Issue:^t" '  { DOCPROPERTY _DocumentIssue  ^92* MERGEFORMAT }"

    ActiveWindow.View.ShowFieldCodes = True

    exitRevision = False
    For i = 65 To 90
       pFindTxt = "Issue:^t^" & i
        'Iterate through all story types in the current document
        For Each rngStory In doc.StoryRanges

            'Iterate through all linked stories
            Do
                If SearchInStory(rngStory, pFindTxt) Then
                    'rngStory.Select
                    'Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldDocProperty, Text:="_DocumentIssue", PreserveFormatting:=True
                    exitRevision = True
                End If
                On Error Resume Next
                Select Case rngStory.StoryType
                    Case WdStoryType.wdEvenPagesHeaderStory, _
                         WdStoryType.wdPrimaryHeaderStory, _
                         WdStoryType.wdEvenPagesFooterStory, _
                         WdStoryType.wdPrimaryFooterStory, _
                         WdStoryType.wdFirstPageHeaderStory, _
                         WdStoryType.wdFirstPageFooterStory
                        If rngStory.ShapeRange.Count > 0 Then
                            For Each oShp In rngStory.ShapeRange
                                If oShp.TextFrame.HasText Then
                                    If SearchInStory(rngStory, pFindTxt) Then
                                        exitRevision = True
                                    End If
                                End If
                            Next
                        End If
                    Case Else
                        'Do Nothing
                    End Select
                    On Error GoTo 0

                    'Get next linked story (if any)
                    Set rngStory = rngStory.NextStoryRange
                Loop Until rngStory Is Nothing
            Next

            If exitRevision Then
                Call CustomProperties.createCustomDocumentProperty(doc, "_DocumentIssue", Chr(i))
                Exit For
            End If

        Next i
        ' Refresh fields
        doc.Fields.update

        ActiveWindow.View.ShowFieldCodes = False
        Exit Sub

    'create the new variable
    Call CustomProperties.createCustomDocumentProperty(doc, "_DocumentIssue", Right(pFindTxtArray, 1))

doesNotExist:
    MsgBox "CustomVariable " & findText & " does not exist"
    Exit Sub

    Debug.Print findText & " variable has got this new name: " & replaceText

End Sub

0 个答案:

没有答案