Automatic numbering of equations in MS Word with help of a VBA Macro

Imagine you have to compile a report in Office Word format and you have many equations which need to equation numbering. Microsoft does not provide an automated solution for this as many Project formatting guidelines require you to have equation alignment on center and equation number aligned on rights side.

Thought Microsoft provided an VBA script in their online web site. The script did not work the way it should be so I modified it and improved it a little bit.

Select equations you want to be captioned, and run this script  Sometimes you need to have "Enter" pressed after the equation or 2 or more enters. If something went wrong just press undo.

I've assigned CTRL+SHIFT+X to this Macro, and in a minute you can have all your equations numbered.

Enjoy

Sub CaptionRight()

   Dim Align As Integer
   On Error GoTo Bye
   Dim rng As Range, rngNew As Range

    If Selection.Range = "" Then
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    End If

    Set rng = Selection.Range
    
' If insertion point is in a table, show message and end macro.
   If Selection.Information(wdWithInTable) Then
      MsgBox "You are in a table. Please move outside of the " _
         & "table to run this macro.", vbInformation
      GoTo Bye
   End If


   ' Ask whether to center or left align equation.
   Align = MsgBox("Would you like the Equation to be " & "centered? " _
      & "(Selecting No will left-align the " & "Equation.)", vbYesNoCancel)

   If Align > 2 Then
      Selection.InsertParagraphAfter
      Selection.Collapse Direction:=wdCollapseEnd
      W = Selection.Sections(1).PageSetup.PageWidth
      L = Selection.Sections(1).PageSetup.LeftMargin
      R = Selection.Sections(1).PageSetup.RightMargin
      RTMarg = W - R - L
      CaptionLabels.Add Name:="("

      If Align = 6 Then
         tblT1 = Selection.Tables.Add(Selection.Range, 1, 3)
      Else
         tblT1 = Selection.Tables.Add(Selection.Range, 1, 2)
      End If

      tblT1.Select

      With Selection
         ' Do this if Center-align selected.
         If Align = 6 Then
            .Columns(1).Cells.Width = 20
            .Columns(3).Cells.Width = 50.4
            .Columns(2).Cells.Width = RTMarg - (50.4 + 20)

            'Represents 1.5" in Points
         Else
         ' Do this if Left-align selected.
            .Columns(2).Cells.Width = 50.4
            .Columns(1).Cells.Width = RTMarg - 50.4
            'Represents .75" in Points
         End If

         .InsertCaption Label:="(", _
            Position:=wdCaptionPositionBelow, Title:=" )"
         .HomeKey Unit:=wdLine, Extend:=wdExtend
         .Cut
         .MoveRight Unit:=wdCharacter, Extend:=wdExtend
         .Delete
         .MoveLeft Unit:=wdCharacter, Count:=2
         .Paste
         .Rows(1).Select

        ' Set the table borders to None.
         For Each x In Selection.Borders
            x.LineStyle = wdLineStyleNone
         Next x

         .Borders.Shadow = False
         .Cells(9 - Align).Select
         .ParagraphFormat.Alignment = wdAlignParagraphRight
         .Cells(1).VerticalAlignment = wdCellAlignVerticalCenter
         .Font.Bold = True
         .Rows(1).Select

         If Align = 6 Then
            .Cells(2).Select
            .ParagraphFormat.Alignment = wdAlignParagraphCenter
         Else
            .Collapse
         End If
      End With
   End If

Bye:
Set rngNew = Selection.Range
rng.Select
rng.Cut
rngNew.Paste
End Sub