使用vba

时间:2016-10-14 11:35:25

标签: vba word-vba

所以在过去的几个月里,我们决定清理我们的单词模板以使用一致的变量名称。在此之前,模板使用混合命名约定,有时使用builtIn主要是customDocumentProperty。例如,创建文档的日期称为Dato,CreatedDate,_Date,DATE,Dato。这个字段应该是从数据库中更新的,找到如何做到这一点很痛苦,所以我愿意与你们分享这个。

因此,现在在新更新的模板中将该字段称为_DocumentCreatedDate,但要将旧文档修复为使用下面的VBA代码。

请务必注意,此字段可以在worddocument,标题,文本框或内容中的任何位置找到。

代码并不完美但它有效,即使它很慢,所以随意使用它,或改进它:)

Sub replaceCustomVariables(doc As Document, findText As String, replaceText As String, autoFixPropType As String)
    Dim temp As Variant

    On Error GoTo doesNotExist

    ' Absolutely no idea why word spell it differnet across word version etc... ^92 is tab
    pFindTxtArray = Split("DOCPROPERTY " & findText & "," & "DOCPROPERTY  " & findText & "," _
            & "DOCPROPERTY """ & findText & """" & "," & "DOCPROPERTY  """ & findText & """," & _
            " " & findText & "  ^92* MERGEFORMAT" & "," & _
            "  " & findText & "  ^92* MERGEFORMAT", ",")

    pReplaceTxt = "DOCPROPERTY " & replaceText

    ActiveWindow.View.ShowFieldCodes = True

    'create the new variable
    If autoFixPropType = "Custom" Then
        oldValue = doc.CustomDocumentProperties(findText).value
    Else
        oldValue = doc.BuiltInDocumentProperties(findText).value
    End If
    Call CustomProperties.createCustomDocumentProperty(doc, replaceText, oldValue)

    For Each pFindTxt In pFindTxtArray

        ' we replace all variables find in textboxes
        For Each objShape In doc.Shapes
          If objShape.Type = msoTextBox Then
            objShape.TextFrame.TextRange.Find.Execute _
              pFindTxt, , , , , , , , , _
              pReplaceTxt, wdReplaceAll
          End If

        Next objShape

        'Iterate through all story types in the current document
        For Each rngStory In doc.StoryRanges

            'Iterate through all linked stories
            Do
                SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
                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
                                    SearchAndReplaceInStory oShp.TextFrame.TextRange, pFindTxt, pReplaceTxt
                                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

        Next
        ' Refresh fields
        doc.Fields.update

        ActiveWindow.View.ShowFieldCodes = False

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

        Exit Sub

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

End Sub

0 个答案:

没有答案