Подсчет использованных вхождений поля пользовательской последовательности в MS Word

Question

Я создал поле пользовательской последовательности для номеров формул:

({STYLEREF "Heading 1" \s}.{SEQ Formula \* ARABIC \s 1}) (выдает следующее: (3.1)).

Мне нужно подсчитать все формулы в текущем документе, чтобы использоватьэто в аннотации.Есть ли способ сделать это автоматически?

Answer 1

В этом случае вы можете добавить поле 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

Answer 2

Благодаря @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, он указал мне правильное направление.

Answer 3

Код для этого на самом деле довольно сложный. Попробуйте:

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