计算 MS Word 中自定义序列字段的使用次数
Count used occurrences of custom sequence field in MS Word
我为公式编号创建了自定义序列字段:
({STYLEREF "Heading 1" \s}.{SEQ Formula \* ARABIC \s 1})
(生成以下内容:(3.1)
)。
我需要计算当前文档中的所有公式才能在摘要中使用它。有没有办法自动完成?
这部分的代码其实很复杂。尝试:
Sub DemoA()
Application.ScreenUpdating = False
Dim Fld As Field, Rng As Range, i As Long
For Each Fld In ActiveDocument.Fields
With Fld
If .Type = wdFieldStyleRef Then
If Trim(.Code.Text) = "STYLEREF ""Heading 1"" \s" Then
If .Result.Characters.First.Previous = "(" Then
If .Result.Characters.Last.Next = "." Then
Set Rng = .Result
With Rng
.End = .End + 3
If .Fields.Count = 2 Then
If .Fields(2).Type = wdFieldSequence Then
If Trim(.Fields(2).Code.Text) = "SEQ Formula \* ARABIC \s 1" Then
If .Fields(2).Result.Characters.Last.Next = ")" Then
i = i + 1
End If
End If
End If
End If
End With
End If
End If
End If
End If
End With
Next
MsgBox "Count: " & i
Application.ScreenUpdating = True
End Sub
或:
Sub DemoB()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(^d STYLEREF ""Heading 1"" \s"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.MoveEndUntil ")", wdForward
If .Text = "(" & Chr(19) & " STYLEREF ""Heading 1"" \s" & Chr(21) & "." & Chr(19) & " SEQ Formula \* ARABIC \s 1" & Chr(21) Then i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub
在这种情况下,您可以将 DOCPROPERTY 字段添加到文档中您希望显示输出的任何位置。 DOCPROPERTY 字段将编码为 {DOCPROPERTY "SEQ#"}。此外,您将替换:
MsgBox "Count: " & i
Application.ScreenUpdating = True
与:
With ActiveDocument
On Error Resume Next
.CustomDocumentProperties.Add Name:="SEQ#", LinkToContent:=False, Value:=0, Type:=msoPropertyTypeNumber
On Error GoTo 0
.CustomDocumentProperties("SEQ#").Value = 1
.Fields.Update
End With
Application.ScreenUpdating = True
或替换:
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox i & " instances found."
与:
With ActiveDocument
On Error Resume Next
.CustomDocumentProperties.Add Name:="SEQ#", LinkToContent:=False, Value:=0, Type:=msoPropertyTypeNumber
On Error GoTo 0
.CustomDocumentProperties("SEQ#").Value = 1
.Fields.Update
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
感谢@macropod,当他发布第二个答案时,我已经有了一个类似的答案。
所以,我需要计算文档中公式、图片和表格的数量。
所有图片都分组在一个带有标题的形状中,这就是为什么我遍历 ActiveDocument.Shapes 以找到需要的图片。
我使用以下宏:
Sub Pictures()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
For Each shp In ActiveDocument.Shapes
If shp.GroupItems(2).TextFrame.TextRange.Text Like "*Picture*" Then i = i + 1
Next
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ActiveDocument.Variables("PicturesCount") = i
ActiveDocument.Fields.Update
Application.StatusBar = i & " pictures found."
End Sub
Sub Formulas()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(^d STYLEREF ""Heading 1 Formula"" \s"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.MoveEndUntil ")", wdForward
If .Text = "(" & Chr(19) & " STYLEREF ""Heading 1"" \s " & Chr(21) & "." & Chr(19) & " SEQ Formula \* ARABIC \s 1 " & Chr(21) Then i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ActiveDocument.Variables("FormulasCount") = i
ActiveDocument.Fields.Update
Application.StatusBar = i & " formulas found."
End Sub
Sub Tables()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "SEQ"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.MoveEndUntil Chr(21), wdForward
If .Text Like "*Table*" Then i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ActiveDocument.Variables("TablesCount") = i
ActiveDocument.Fields.Update
Application.StatusBar = i & " tables found."
End Sub
Sub All()
Pictures
Formulas
Tables
End Sub
然后我在文档中使用这些值:
In this document there are { NUMPAGES \* Arabic \* MERGEFORMAT } pages, { DOCVARIABLE PicturesCount \* MERGEFORMAT } pictures, { DOCVARIABLE FormulasCount \* MERGEFORMAT } formulas and { DOCVARIABLE TablesCount \* MERGEFORMAT } tables.
现在应该调用宏来更新文档中的值。
再次感谢@macropod,他为我指明了正确的方向。
我为公式编号创建了自定义序列字段:
({STYLEREF "Heading 1" \s}.{SEQ Formula \* ARABIC \s 1})
(生成以下内容:(3.1)
)。
我需要计算当前文档中的所有公式才能在摘要中使用它。有没有办法自动完成?
这部分的代码其实很复杂。尝试:
Sub DemoA()
Application.ScreenUpdating = False
Dim Fld As Field, Rng As Range, i As Long
For Each Fld In ActiveDocument.Fields
With Fld
If .Type = wdFieldStyleRef Then
If Trim(.Code.Text) = "STYLEREF ""Heading 1"" \s" Then
If .Result.Characters.First.Previous = "(" Then
If .Result.Characters.Last.Next = "." Then
Set Rng = .Result
With Rng
.End = .End + 3
If .Fields.Count = 2 Then
If .Fields(2).Type = wdFieldSequence Then
If Trim(.Fields(2).Code.Text) = "SEQ Formula \* ARABIC \s 1" Then
If .Fields(2).Result.Characters.Last.Next = ")" Then
i = i + 1
End If
End If
End If
End If
End With
End If
End If
End If
End If
End With
Next
MsgBox "Count: " & i
Application.ScreenUpdating = True
End Sub
或:
Sub DemoB()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(^d STYLEREF ""Heading 1"" \s"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.MoveEndUntil ")", wdForward
If .Text = "(" & Chr(19) & " STYLEREF ""Heading 1"" \s" & Chr(21) & "." & Chr(19) & " SEQ Formula \* ARABIC \s 1" & Chr(21) Then i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub
在这种情况下,您可以将 DOCPROPERTY 字段添加到文档中您希望显示输出的任何位置。 DOCPROPERTY 字段将编码为 {DOCPROPERTY "SEQ#"}。此外,您将替换:
MsgBox "Count: " & i
Application.ScreenUpdating = True
与:
With ActiveDocument
On Error Resume Next
.CustomDocumentProperties.Add Name:="SEQ#", LinkToContent:=False, Value:=0, Type:=msoPropertyTypeNumber
On Error GoTo 0
.CustomDocumentProperties("SEQ#").Value = 1
.Fields.Update
End With
Application.ScreenUpdating = True
或替换:
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox i & " instances found."
与:
With ActiveDocument
On Error Resume Next
.CustomDocumentProperties.Add Name:="SEQ#", LinkToContent:=False, Value:=0, Type:=msoPropertyTypeNumber
On Error GoTo 0
.CustomDocumentProperties("SEQ#").Value = 1
.Fields.Update
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
感谢@macropod,当他发布第二个答案时,我已经有了一个类似的答案。 所以,我需要计算文档中公式、图片和表格的数量。
所有图片都分组在一个带有标题的形状中,这就是为什么我遍历 ActiveDocument.Shapes 以找到需要的图片。
我使用以下宏:
Sub Pictures()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
For Each shp In ActiveDocument.Shapes
If shp.GroupItems(2).TextFrame.TextRange.Text Like "*Picture*" Then i = i + 1
Next
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ActiveDocument.Variables("PicturesCount") = i
ActiveDocument.Fields.Update
Application.StatusBar = i & " pictures found."
End Sub
Sub Formulas()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(^d STYLEREF ""Heading 1 Formula"" \s"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.MoveEndUntil ")", wdForward
If .Text = "(" & Chr(19) & " STYLEREF ""Heading 1"" \s " & Chr(21) & "." & Chr(19) & " SEQ Formula \* ARABIC \s 1 " & Chr(21) Then i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ActiveDocument.Variables("FormulasCount") = i
ActiveDocument.Fields.Update
Application.StatusBar = i & " formulas found."
End Sub
Sub Tables()
Application.ScreenUpdating = False
Dim i As Long
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "SEQ"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
.MoveEndUntil Chr(21), wdForward
If .Text Like "*Table*" Then i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
ActiveDocument.Variables("TablesCount") = i
ActiveDocument.Fields.Update
Application.StatusBar = i & " tables found."
End Sub
Sub All()
Pictures
Formulas
Tables
End Sub
然后我在文档中使用这些值:
In this document there are { NUMPAGES \* Arabic \* MERGEFORMAT } pages, { DOCVARIABLE PicturesCount \* MERGEFORMAT } pictures, { DOCVARIABLE FormulasCount \* MERGEFORMAT } formulas and { DOCVARIABLE TablesCount \* MERGEFORMAT } tables.
现在应该调用宏来更新文档中的值。
再次感谢@macropod,他为我指明了正确的方向。