所以在过去的几个月里,我们决定清理我们的单词模板以使用一致的变量名称。在此之前,模板使用混合命名约定,有时使用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