-1

I've created a custom sequence field for formula numbers:

({STYLEREF "Heading 1" \s}.{SEQ Formula \* ARABIC \s 1}) (produces following: (3.1)).

I need to count all formulas in current document to use it in Abstract. Is there a way to do it automatically?

melpomene
  • 84,125
  • 8
  • 85
  • 148
Egor Shulga
  • 5
  • 2
  • 4
  • The answer is in your question. – freeflow May 08 '19 at 18:08
  • @Freeflow Hardly. While a *wildcard* Find could be used to count the number of strings in the (3.1) format, that is not to say all such strings apply to formula references. A string in the (3.1) format might apply to any cross-reference, for example. – macropod May 08 '19 at 22:38
  • @Macropod. The seq field contains the name 'Formula' therefor it is possible to iterate over document fields testing for sequence fields that have the text 'Formula' in the code. Simples. – freeflow May 08 '19 at 22:45
  • Not so simple if , as specified, that SEQ field needs to be preceded by a particular STYLEREF field, then a period. – macropod May 09 '19 at 03:32
  • @Freeflow @macropod Actually, sequence `Formula` is unique, it is used only with `STYLEREF` and a period before it. So, we could count a number of `{SEQ Formula}` as the number of all constructs like this. Could you advise, how it is possible to iterate through document fields? – Egor Shulga May 09 '19 at 15:54
  • https://learn.microsoft.com/en-us/office/vba/word/concepts/customizing-word/looping-through-a-collection – freeflow May 09 '19 at 16:02

3 Answers3

0

The code for this is actually quite involved. Try:

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

or:

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
macropod
  • 12,757
  • 2
  • 9
  • 21
  • That looks great! A small question though: could we output the value produced by the macro into a field in the document, so it could be updated automatically (or by pressing F9, like TOC is updated)? – Egor Shulga May 12 '19 at 07:44
0

In that case, you could add a DOCPROPERTY field to the document wherever you want the output to appear. The DOCPROPERTY field would be coded as {DOCPROPERTY "SEQ#"}. Additionally, you'd replace:

MsgBox "Count: " & i
Application.ScreenUpdating = True

with:

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

or replace:

ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox i & " instances found."

with:

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
  • 12,757
  • 2
  • 9
  • 21
0

Thanks to @macropod, by the time he posted a second answer, I came with a similar one. So, I need to calculate count of formulas, pictures and tables in my document.

All pictures are grouped within a shape with its captions, that is why I iterate over ActiveDocument.Shapes to find a needed one.

I use following macros:

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

And then I use these values in the document:

In this document there are { NUMPAGES \* Arabic \* MERGEFORMAT } pages, { DOCVARIABLE PicturesCount \* MERGEFORMAT } pictures, { DOCVARIABLE FormulasCount \* MERGEFORMAT } formulas and { DOCVARIABLE TablesCount \* MERGEFORMAT } tables.

And now the macro should be called to update the values in the document.

Thanks again to @macropod, he pointed me to the right direction.

Egor Shulga
  • 5
  • 2
  • 4