在文本框中查找变量

时间:2017-11-02 11:40:57

标签: vba word-vba

使用包含word2016中的变量的文本框时出现问题。

我想预先搜索可能存在于文本框文本中的变量,并且在某些情况下我想用新变量替换它。示例文本框如下所示:

enter image description here

我想搜索DOCPROPERTY" Checked By"。文本框中不存在DOCPROPERTY,但文本" Checked By"确实如此,但下面附带的代码无论如何都能找到它。因为它不是DOCPROPERTY,所以它不应该返回true。

' ************************************************************
' ********* finding docproperties in text, headers and textboxes
' **************************************************************
Public Function findProperty(doc As Document, findText As String) As Boolean
    Dim rngStory As word.Range
    Dim oFld As word.Field
    Dim objShape As Shape
    Dim temp As String
    Dim temp2() As String
    Dim element As Variant

    ActiveWindow.View.ShowFieldCodes = True
    If findText = "_DocumentTitle" Then
        findProperty = True
        Exit Function
    End If

    findProperty = False


    For Each objShape In ActiveDocument.Shapes
        If objShape.Type = msoTextBox Then
            'do the required action
            temp2 = Split(objShape.TextFrame.TextRange.Text, "DOCPROPERTY")
            For Each element In temp2
                temp = replace(element, "DOCPROPERTY", "")
                temp = replace(temp, "\* MERGEFORMAT", "")
                temp = replace(temp, """", "")
                If InStr(UCase(temp), Trim(UCase(findText))) > 0 Then
                  findProperty = True
                  Exit Function
                End If
            Next

        End If
    Next objShape

    For Each rngStory In doc.StoryRanges
      Do
        For Each oFld In rngStory.Fields
          'If oFld.Type = wdFieldDocProperty Then
              'Dig a little deeper and see what the field code contains.
              'Formatting of property is a pain....
              temp = replace(oFld.Code.Text, "DOCPROPERTY", "")
              temp = replace(temp, "\* MERGEFORMAT", "")
              temp = replace(temp, """", "")
              If Trim(UCase(temp)) = Trim(UCase(findText)) Then
                findProperty = True
                Exit Function
              End If

        Next oFld
        Set rngStory = rngStory.NextStoryRange
      Loop Until rngStory Is Nothing
    Next rngStory
    ActiveWindow.View.ShowFieldCodes = False
End Function

2 个答案:

答案 0 :(得分:0)

您使用"DOCPROPERTY"作为分隔符将字符串拆分为数组,因此无需使用vbNullString(“”)替换“DOCPROPERTY”。

        temp2 = Split(objShape.TextFrame.TextRange.Text, "DOCPROPERTY")
        For Each element In temp2
            temp = replace(element, "DOCPROPERTY", "")

我认为您可以测试temp2的大小,如果它大于0,那么找到"DOCPROPERTY",如果它是0那么找不到"DOCPROPERTY"

if UBound(temp2) > 0 then findProperty = True

但是可能更好的方法是查看Field(n).code,它返回字段代码文本然后你就知道你拥有的......

答案 1 :(得分:0)

@SlowLearner的建议是下面的工作代码。

Public Function findProperty(doc As Document, findText As String) As Boolean
    Dim rngStory As word.Range
    Dim oFld As word.Field
    Dim objShape As Shape
    Dim element As Variant

    findProperty = False 'default false
    '**************************************************************************************
    '**************** ALL DOCUMENTS NEED A TITLE EVEN IF ITS NOT IN USE *******************
    '**************************************************************************************
    If findText = "_DocumentTitle" Then
        findProperty = True
        Exit Function
    End If


    For Each objShape In ActiveDocument.Shapes
        If objShape.Type = msoTextBox Then
            'do the required action
            For Each element In objShape.TextFrame.TextRange.Fields
                If InStr(UCase(element.Code.Text), Trim(UCase(findText))) > 0 Then
                  findProperty = True
                  Exit Function
                End If
            Next element
        End If
    Next objShape

    For Each rngStory In doc.StoryRanges
      Do
        For Each oFld In rngStory.Fields
              'Dig a little deeper and see what the field code contains.
              If InStr(UCase(oFld.Code.Text), Trim(UCase(findText))) > 0 Then
                findProperty = True
                Exit Function
              End If

        Next oFld
        Set rngStory = rngStory.NextStoryRange
      Loop Until rngStory Is Nothing
    Next rngStory

End Function