Malicious Office (OLE) — malware analysis report

Attribute VB_Name = "ThisDocument"
Attribute VB_Base = "1Normal.ThisDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = True
Attribute VB_Customizable = True

Private Sub Document_Close()
    ActiveDocument.UpdateStylesOnOpen = False 'prevent other styles from being added accidentally
'    If (CheckWordVersion >= 12) Then
        'ask to reset or import customizations
'        Select Case MsgBox("Reset ribbon or import customization file?", vbYesNo, "Ribbon Reset")
'            Case 6          'vbYes
'
'            Case 7          'vbNo
'                Exit Sub
'        End Select
End Sub
Private Sub Document_Open()
    With ActiveDocument
        .UpdateStylesOnOpen = False
        .AttachedTemplate = ""
On Error GoTo FailCmdBarTemplate
        With .CommandBars("IEEEStdsTemplate")
            .Enabled = True
            .Visible = True
        End With
On Error GoTo FailCmdBarFormatting
        With .CommandBars("IEEEStdsFormatting")
            .Enabled = True
            .Visible = True
        End With
On Error Resume Next
    End With
    
    If (ActiveDocument.Variables("IsNew").Value = "Y") Then
        ActiveWindow.View.FieldShading = wdFieldShadingAlways
        welcome.Show
        doc_info.Show vbModeless
        ActiveDocument.Variables("IsNew").Value = "N"
    End If
    Exit Sub

FailCmdBarTemplate:
    MsgBox "The IEEEStdsTemplate toolbar has not loaded."
    Exit Sub
FailCmdBarFormatting:
    MsgBox "The IEEEStdsFormatting toolbar has not loaded."
    Exit Sub
End Sub


Attribute VB_Name = "add_annex"
Attribute VB_Base = "0{93FA7A77-EE3B-4F68-9717-9E9375B83811}{DE44F4CC-4417-4BE2-872F-9430A0BD27CE}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub OK_Click()
Dim strType As String
'error handling
    If ((Me.annex_title.Value = "") Or (Not (Me.normative.Value) And Not (Me.informative.Value))) Then
        MsgBox "You must enter a title for the Annex and select Normative or Informative, or click Cancel to exit."
        Exit Sub
    End If
    If (Me.normative.Value) Then
        strType = "(normative)"
    Else: strType = "(informative)"
    End If
    InsAnnex Me.annex_title.Value, strType
    Unload Me
End Sub
Private Sub cancel_Click()
    Unload Me
End Sub

Attribute VB_Name = "welcome"
Attribute VB_Base = "0{21CCA926-FEDE-4811-A7A9-E2287F57AEE7}{7721CCF0-E248-49FF-B2B3-89EC01A1A055}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub OK_Click()
    Unload Me
End Sub

Private Sub UserForm_Initialize()
    Me.lblTemplVers.Caption = "Version " & ActiveDocument.Variables("VersionTemplate").Value
End Sub

Attribute VB_Name = "change_def_level"
Attribute VB_Base = "0{3FACF92A-AC11-4531-B515-66CDD221A9C4}{49C99BF6-0F38-41E6-A46D-3C204DD0255B}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub cancel_Click()
    Unload Me
End Sub

Private Sub SaveClose_Click()
''update docvariable based on form selections
    UpdateVariable
    Unload Me
End Sub

Private Sub SaveFormat_Click()
''update docvariable based on form selections
    UpdateVariable
    Unload Me
''format with new parameter
    MakeDefsFmt
End Sub

Private Sub termnum_Change()
    If Me.termnum.Value = True Then
        Me.level2.Enabled = True
        Me.level3.Enabled = True
        Me.prompt_select.Visible = True
    ElseIf Me.termnum.Value = False Then
        Me.level2.Enabled = False
        Me.level3.Enabled = False
        Me.prompt_select.Visible = False
    End If
End Sub

Private Sub UserForm_Initialize()
    With Me
        Select Case ActiveDocument.Variables("DefTermLevelBelow").Value
            Case "1"    'Level 2 term numbering
                .level2.Value = True
                .prompt_select.Visible = True
                .termnum.Value = True
            Case "2"    'Level 3 term numbering
                .level3.Value = True
                .prompt_select.Visible = True
                .termnum.Value = True
            Case "99"   'No numbering
                .level2.Enabled = False
                .level3.Enabled = False
                .termnum.Value = False
                .prompt_select.Visible = False
            Case Else   'Nothing selected yet (first-time use)
                .level2.Enabled = False
                .level3.Enabled = False
                .termnum.Value = False
                .prompt_select.Visible = True
        End Select
    End With
End Sub

Sub UpdateVariable()
    With ActiveDocument.Variables("DefTermLevelBelow")
        If (Me.termnum.Value = False) Then
            .Value = "99"   'sets as NO NUMBERING
        ElseIf (Me.level2.Value = True) Then
            .Value = "1"   'sets as first level header
        ElseIf (Me.level3.Value = True) Then
            .Value = "2"   'sets as second level header
        Else    'state is numbering true, but no level set
            MsgBox ("Please select a term numbering level.")
            Exit Sub
        End If
    End With
End Sub

Attribute VB_Name = "def_fmt_overview"
Attribute VB_Base = "0{E2C7368C-10EB-4E19-BE62-2F7479868422}{35212AD7-A2A1-4349-9F8D-8259E98420D8}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Private Sub OK_Click()
    Unload Me
End Sub
Private Sub cancel_Click()
    Unload Me
End Sub

Attribute VB_Name = "add_equation"
Attribute VB_Base = "0{F0C21BD7-5E43-47BD-BA00-3E760FA8ECA6}{3E2ED936-5908-4767-9849-1716CC6A492B}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub cancel_Click()
    Unload Me
End Sub

Private Sub insert_Click()
Dim varInsert As Variant, myFields As Fields, thisField As Field, strAnnex As String
    CheckWhere
    If Not ((Me.optAnnex.Value) Or (Me.optBody.Value)) Then  'check missing location or object to insert
        MsgBox ("You must indicate where the equation is located:" & vbCr & _
        "in the regular body of the standard or in an annex.")
        Me.eq_type.SetFocus
        Exit Sub
    End If
    If Not ((Me.optNumOnly.Value) Or (Me.optMSEQobj.Value) Or (Me.optGraphic.Value)) Then
        MsgBox ("You must select an item to insert.")
        Me.ins_which.SetFocus
        Exit Sub
    End If
    If (Me.optNumOnly.Value) Then  'skip dialogs, just add number
        If Not (MsgBox("Use this function only to add new numbering for existing equations. Also, " & vbCr & _
        "the cursor must be positioned at the end of the equation line after the tab stop. " & vbCr & _
        "Click Cancel to exit and move cursor.", vbOKCancel, "Warning!") = 1) Then: Exit Sub
        GoTo AddNum
    End If
    If (Me.optMSEQobj.Value) Then: varInsert = wdDialogInsertObject
    If (Me.optGraphic.Value) Then: varInsert = wdDialogInsertPicture
    If Not (Dialogs(varInsert).Show = -1) Then: Exit Sub    'back to form if Close or Cancel
AddNum:
        Selection.Style = ActiveDocument.Styles("IEEEStds Equation")
        If Not (Me.optNumOnly.Value) Then: Selection.TypeText Text:=vbTab    'don't add tab if numonly
        Selection.Collapse Direction:=wdCollapseEnd
        If (Me.optBody.Value) Then  'for regular equations
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                "LISTNUM STDS_EQ", PreserveFormatting:=True
        ElseIf (Me.optAnnex.Value) Then 'for annex equations
            'error handling for lack of annex style present in document, which will throw an error.
            Set myFields = ActiveDocument.Fields
            Set thisField = myFields.Add(Selection.Range, wdFieldStyleRef, """Heading 1"" \n")
            If thisField.Result.Text = "Error! No text of specified style in document." Then
                MsgBox ("There are no annexes defined. Please create an annex, then go back and " & _
                "add numbering to your equation.")
                thisField.Delete
                GoTo Exit_sub   'go back so user can add annex clause
            End If
            strAnnex = Mid(thisField.Result.Text, 7, 1) 'extract the annex number from the actual text
            thisField.Delete    'having tested for existence of annex number, and getting it, delete the field
            'now add the correctly formatted annex eq field, but because there is no function to add this type
            'of field with the necessary format, must "manually" update the field after adding it
            Set thisField = myFields.Add(Selection.Range, wdFieldQuote, "(" & strAnnex & ".)")
            'show the codes in order to manually update
            thisField.ShowCodes = True
            thisField.Select
            Selection.Collapse Direction:=wdCollapseStart
            Selection.MoveRight Unit:=wdCharacter, Count:=11
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldSequence, Text:= _
                "ANX_" & strAnnex & "_EQ", PreserveFormatting:=True
            ActiveDocument.Fields.Update
            Selection.Move Unit:=wdParagraph, Count:=1
        End If
Exit_sub:
    Unload Me
'If updated, function below might be used to shorten the procedure above.
'Function InsEq(varDialogType As Variant)
'    CheckWhere
'    If (Dialogs(varDialogType).Show = -1) Then
'        With Selection
'            .Style = ActiveDocument.Styles("IEEEStds Equation")
'            .MoveEnd
'            .TypeText Text:=vbTab
'            .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
'                "LISTNUM STDS_EQ", PreserveFormatting:=True
'        End With
'    End If
'End Function
End Sub


Attribute VB_Name = "add_notes"
Attribute VB_Base = "0{1A30A517-C289-46A8-98D3-D4EB362D57EF}{A1935548-0637-42D5-8FA0-6BF46537D708}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False


Private Sub OK_Click()
Dim lstLT As ListTemplate
Dim styForNums As Style
    If (Me.single_note.Value) Then
        Selection.Collapse Direction:=wdCollapseStart
        InsFmtText "NOTE" & Chr(151), "IEEEStds Single Note", wdCollapseEnd
    ElseIf (Me.multiple_notes.Value) Then
        Selection.Collapse Direction:=wdCollapseStart
        InsFmtText vbCr, "IEEEStds Multiple Notes", wdCollapseStart
        Selection.Select
        Set styForNums = ActiveDocument.Styles("IEEEStds Multiple Notes")   'Set up objects
        Set lstLT = styForNums.ListTemplate
        Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=lstLT, ContinuePreviousList:=False        'Reset numbering
    Else
        MsgBox "You must select either Single Note or Multiple Notes, or click Cancel to exit."
        Exit Sub
    End If
    Unload Me
End Sub

Private Sub cancel_Click()
    Unload Me
End Sub

Private Sub single_note_Click()
    Me.instructions.Visible = False
End Sub

Private Sub multiple_notes_Click()
    Me.instructions.Visible = True
End Sub


Attribute VB_Name = "add_overview"
Attribute VB_Base = "0{D8FE4744-B3A9-4284-842E-BC5DCAE1B584}{DA87F7C1-C7A4-46C8-852A-4204F890DCBB}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub InsertHeadings_Click()
Dim intMissing As Integer
    Selection.Collapse Direction:=wdCollapseStart
    If (Me.all.Value) Then
        InsFmtText "Overview" & vbCr, "IEEEStds Level 1 Header", wdCollapseEnd
        InsFmtText "Scope" & vbCr & "Purpose" & vbCr, "IEEEStds Level 2 Header", wdCollapseEnd
    ElseIf (Me.scope.Value) Then
        InsFmtText "Scope" & vbCr, "IEEEStds Level 1 Header", wdCollapseEnd
    Else
        intMissing = MsgBox("You must make a choice, or click Cancel to exit.", vbOKOnly, "Nothing Chosen")
        Exit Sub
    End If
    Selection.Move Unit:=wdCharacter, Count:=-1
    Unload Me
End Sub
Private Sub cancel_Click()
    Unload Me
End Sub
Private Sub all_Click()
    instructions.Visible = True
End Sub
Private Sub scope_Click()
    instructions.Visible = False
End Sub

Attribute VB_Name = "add_references_head"
Attribute VB_Base = "0{9083E8F1-0244-4B3D-84D2-03E8F42740B4}{10653B91-F05B-4F3B-BEA3-15F2E401B90A}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False

Private Sub OK_Click()
    CheckWhere
    InsFmtText "Normative references" & vbCr, "IEEEStds Level 1 Header", wdCollapseEnd    'header
    InsFmtText "The following referenced documents are indispensable for the application " & _
    "of this document (i.e., they must be understood and used, so each referenced document is cited " & _
    "in text and its relationship to this document is explained). For dated references, only " & _
    "the edition cited applies. For undated references, the latest edition of the referenced document " & _
    "(including any amendments or corrigenda) applies." & vbCr, "IEEEStds Paragraph", wdCollapseEnd
    Unload Me
End Sub

Private Sub cancel_Click()
    Unload Me
End Sub


Attribute VB_Name = "NewMacros"
Sub DisplayVariables()
'Show all current custom docvariables
    Dim myVar As Variable, mystring As String, myCount As Integer, myTab As String
    mystring = "                    LIST OF CUSTOM DOCVARIABLES" & Chr(13)
    myCount = 0
    MsgBox "The total number of variables is: " & ActiveDocument.Variables.Count
    For Each myVar In ActiveDocument.Variables
        myCount = myCount + 1
        Select Case myVar.Name  'format tabular display for msgbox
            Case "tabfigcaps", "txtTrialUse", "idxTrialUse", "varTitlePAR", "varRevision", "varSociety", "IsNew", "varCRYear", "varISBNpdf", "varISBNprint", "varStdIDpdf"
                myTab = Chr(9) & Chr(9)
            Case Else
                myTab = Chr(9)
        End Select
        mystring = mystring & Chr(13) & "Name: " & myVar.Name & myTab & "Value: " & myVar.Value
        Select Case myCount
            Case 20
                MsgBox mystring & Chr(13) & Chr(13) & Chr(9) & Chr(9) & "Click OK to continue"
                mystring = "                    LIST OF CUSTOM DOCVARIABLES (con't)" & Chr(13)
            Case ActiveDocument.Variables.Count
                MsgBox mystring
        End Select
    Next myVar
End Sub
Sub DocVarAssignmentForTesting()
Dim thisVar As String, thisVal As String
    thisVar = "varDocSbType"    'set/reset the variable name for testing
    thisVal = "none"       'set/reset the variable value for testing
    With ActiveDocument.Variables
        .Item(thisVar).Delete   'comment out this line if not a standard variable (remember to delete later)
        .Add thisVar, thisVal
    End With
End Sub
Sub ResetDocInfoVariables()
On Error Resume Next
'run to reset document variables, for programmatic use only
'to set document for first-time use, comment out line in MakeHeaderFooter that
'assigns Copyright Year as the current year and REMEMBER TO CHANGE IT BACK!
    For Each Variable In ActiveDocument.Variables
        Variable.Delete
    Next Variable
    With ActiveDocument.Variables
        .Add "ActionOutcome", "0"
        .Add "DefTermLevelBelow", "0"
        .Add "idxGorRPorSTD", "0"
        .Add "idxTrialUse", "0"
        .Add "IsNew", "Y"
        .Add "tabfigcaps", "none"
        .Add "txtGorRPorSTD", "<Gde./Rec. Prac./Std.>"
        .Add "txtTrialUse", "<opt_Trial-Use>"
        .Add "varApprovedDate", "<Date Approved>"
        .Add "varApprovedDay", "0"
        .Add "varApprovedMonth", "0"
        .Add "varApprovedYear", "0"
        .Add "varCommittee", "<Committee Name>"
        .Add "varCRYear", "<Copyright Year>"
        .Add "varDesignation", "<designation>"
        .Add "varDocSbType", "none"
        .Add "varDocSbTypeTxt1", "0"
        .Add "varDocSbTypeTxt2", "0"
        .Add "varDraftFinal", "Draft"
        .Add "varDraftMonth", "<draft_month>"
        .Add "varDraftNumber", "<draft_number>"
        .Add "varDraftYear", "<draft_year>"
        .Add "varISBNpdf", "978-0-XXXX-XXXX-X"
        .Add "varISBNprint", "978-0-XXXX-XXXX-X"
        .Add "varPublishedDate", "<Date Published>"
        .Add "varPublishedDay", "0"
        .Add "varPublishedMonth", "0"
        .Add "varPublishedYear", "0"
        .Add "varSociety", "<Society Name>"
        .Add "varStdIDpdf", "STDXXXXX"
        .Add "varStdIDprint", "STDPDXXXXX"
        .Add "varTitlePAR", "<Complete Title Matching PAR>"
        .Add "varWkGrpChair", "<Chair Name>"
        .Add "varWkGrpViceChair", "<Vice-chair Name>"
        .Add "varWorkingGroup", "<Working Group Name>"
        .Add "StopUpdateTitles", "False"
        .Add "StopUpdateHeaders", "False"
        .Add "VersionTemplate", "2.118"
    End With
    UpdateAllFields
End Sub

Public Function MakeMonths(myObj As Variant)
        With myObj
            .AddItem (" ")
            .AddItem ("January")
            .AddItem ("February")
            .AddItem ("March")
            .AddItem ("April")
            .AddItem ("May")
            .AddItem ("June")
            .AddItem ("July")
            .AddItem ("August")
            .AddItem ("September")
            .AddItem ("October")
            .AddItem ("November")
            .AddItem ("December")
        End With
End Function
Sub AddAnnex()
    add_annex.Show
End Sub
Sub AddNotes()
    add_notes.Show
End Sub
Sub AddOverview()
    add_overview.Show
End Sub
Function AddTermNumber(numLevel As String) As Boolean
On Error Resume Next
    With Selection
        .Collapse Direction:=wdCollapseStart
        .Fields.Add Range:=Selection.Range, Type:=wdFieldStyleRef, Text:="""IEEEStds Level " & numLevel & " Header""\n", PreserveFormatting:=True
        .Collapse Direction:=wdCollapseEnd
        .TypeText Text:="."
        .Fields.Add Range:=Selection.Range, Type:=wdFieldListNum, Text:="DEFINITION", PreserveFormatting:=True
    End With
    AddTermNumber = 1
End Function
Sub MakeDefsFmt()
''The docvariable DefTermLevelBelow must be set prior to running this function.
Dim strToSrch As String, origRange As Range, myStyle As Style, NewLevel As String, myRange As Range
'next line forces Set/Change numbering on first format.
    If (ActiveDocument.Variables("DefTermLevelBelow").Value = "0") Then
        MsgBox "Term numbering not set. Please go to Definitions -> Set/change numbering for Terms..."
        Exit Sub
    End If
    NewLevel = ActiveDocument.Variables("DefTermLevelBelow").Value
    Set origRange = Selection.Range
    strToSrch = origRange.Text
    Set myStyle = ActiveDocument.Styles("IEEEStds Definitions")
'''set of exclusions...
'if nothing is selected, then exit
    If (strToSrch = "") Then
        MsgBox "Please select terms+definitions to be formatted or changed."
        Exit Sub
    End If
'escape if there are extra returns
    If (InStr(strToSrch, vbCr & vbCr) <> 0) Then
        MsgBox "Extra paragraph returns must be removed between defintions before using this function."
        Exit Sub
    End If
''Format clause heading, escape if not found
    ActiveDocument.Content.Select   'must use Selection object to have the Execute method select the found text.
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        If Not (.Execute(FindText:="Definitions" & vbCr, Forward:=True, Wrap:=wdFindContinue, Format:=False)) Then
            MsgBox "Definitions clause heading not found, which may cause errors. " & vbCr & _
            "Copy and paste (& keep formatting) the Definitions clause heading and first paragraph " & vbCr & _
            "from a new IEEE draft standard template. (Selecting the whole paragraph will also copy the footnote.)"
            Exit Sub
        End If
        If (NewLevel <> "99") Then: Selection.Style = "IEEEStds Level " & NewLevel & " Header"  'no reason to change header if there is no numbering
    End With
    origRange.Select    'go back to original position before formatting
'''end exclusions
'''(Re)format
    GoSub RemoveNumbering
    GoSub FormatAllTermsDefs
    GoSub AddNums
    GoSub FormatExtras
    GoSub ArrAlpha
    
    Exit Sub
''~~~~~SUBROUTINES~~~~~~
'''Clear all formatting and existing numbering
RemoveNumbering:
Dim myField As Field
    Set myRange = origRange
    With myRange
        If .Fields.Count = 0 Then: Return   'don't bother continuing if no numbering
        For Each myField In myRange.Fields
            myField.Select
            myField.Delete
            Selection.MoveEnd Unit:=wdCharacter, Count:=1    'checking for the "." in between styleref and counter fields
            If Selection.Text = "." Then: Selection.Delete
        Next myField
    End With
    myRange.Select  'select entire section for formatting (next GoSub)
    Return

FormatAllTermsDefs:
Dim myCount As Integer, X As Integer, myEnd As Range
'formats one line or section: terms and definitions
    With Selection
        .ClearFormatting                        'remove all prior formatting
        .Style = "IEEEStds Definitions"         'apply Definitions style to selection
'if last line in document or final return not selected, then add a return
        If (Right(strToSrch, 1) <> vbCr) Then: strToSrch = strToSrch + vbCr
    End With
    Return  'Range of selection not changed, so no need to reset for next GoSub

AddNums:
    With Selection
        myCount = 0
        While InStr(strToSrch, vbCr)    'strToSrch acts as a type of counter, but actions are performed on the Selection
            Select Case NewLevel    'Case "99" -> do nothing (99 -> No numbering)
                Case "1", "2"
                    If Not (AddTermNumber(NewLevel)) Then: Exit Sub      'call function; escape if number not added
                Case "0"
                    MsgBox ("Term numbering level not set. Click Definitions -> Set/change numbering level for all Terms...")
                    Exit Sub
            End Select
            .MoveUntil Cset:=vbCr, Count:=wdBackward
            .MoveDown Unit:=wdParagraph
            strToSrch = Mid(strToSrch, InStr(strToSrch, vbCr) + 1)
            myCount = myCount + 1
        Wend
        .MoveUp Unit:=wdParagraph, Count:=myCount
        .MoveRight Extend:=wdExtend                                    'move back to start for formatting
    End With

FormatBold:
    With Selection
        For X = 1 To (myCount)                                     'go thru each line, make bold
            Set myEnd = ActiveDocument.Range(start:=0, End:=0)
            myEnd.SetRange start:=ActiveDocument.Content.start, End:=ActiveDocument.Content.End   'define End range
            myEnd.Collapse Direction:=wdCollapseEnd
            myEnd.MoveStart Count:=-1
            While (.Text <> ":")
                If ((.Text = vbCr) Or (.Range.End = myEnd.End)) Then       'escape if end of line or end of story
                    MsgBox "Reached end of line. " & _
                    "No term found. Missing colon (:) in definition." & vbCr & _
                    "Add the colon just after the term, select entire line and format."
                    Exit Sub                       'escape term bold if no colon (:) is found
                End If
                .MoveRight
                .MoveRight Extend:=wdExtend
            Wend
            .MoveRight
            .MoveStart Unit:=wdParagraph, Count:=-1
            .Style = "IEEEStds DefTerms+Numbers"
            .Collapse Direction:=wdCollapseStart
            .MoveDown Unit:=wdParagraph
        Next X
    End With
    origRange.Select
    Return
    
FormatExtras:
'Make "See also:" italic, make following term(s) bold. Check style for specifics.
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Replacement.Text = "^&"
        .Replacement.Font.Italic = True
        .Execute FindText:="See also:", MatchCase:=True, Forward:=True, Wrap:=wdFindStop, Format:=True, Replace:=wdReplaceAll
    End With
    origRange.Select
    GoSub ResetSearchSee_Also
    With Selection.Find
        While (.Found)
            .Execute
            Set myRange = Selection.Range
            With myRange    'format whole selection w/ bolded style, then remove from commas, spaces, periods & hard returns
                .MoveStartUntil Cset:=":", Count:=wdForward
                .MoveStart Count:=2
                .MoveEnd Count:=-1
                .Style = ActiveDocument.Styles("IEEEStds DefTerms+Numbers")
                .Find.ClearFormatting
                .Find.Replacement.ClearFormatting
                .Find.Replacement.Text = "^&"
                .Find.Replacement.Style = wdStyleDefaultParagraphFont
                ''''MAKE AN ARRAY FOR THIS!!!
                .Find.Execute FindText:=", ", Forward:=True, Wrap:=wdFindStop, Format:=True, Replace:=wdReplaceAll
                .Find.Execute FindText:=".", Forward:=True, Wrap:=wdFindStop, Format:=True, Replace:=wdReplaceAll
                .Find.Execute FindText:="; ", Forward:=True, Wrap:=wdFindStop, Format:=True, Replace:=wdReplaceAll
               GoSub ResetSearchSee_Also
            End With
        Wend
    End With
    origRange.Select
    Return

ArrAlpha:
'alphabetize terms
    origRange.Sort
    Return
    
ResetSearchSee_Also:
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "See*: *" & vbCr
        .Style = "IEEEStds Definitions"
        .MatchWildcards = True
        .MatchCase = True
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
    End With
    Return

End Sub

Sub DefFmtOverview()
    def_fmt_overview.Show vbModeless
End Sub
Sub AddDefsHead()
'THIS FUNCTION ADDS THE DEFINITIONS CLAUSE HEADING, TEXT AND FOOTNOTE
Dim myInitView As View
    Set myInitView = ActiveDocument.ActiveWindow.View   'mark starting view, for exiting footnote view later
    With Selection
        CheckWhere
        .MoveEnd Unit:=wdParagraph, Count:=1
        .ClearFormatting
        .Collapse Direction:=wdCollapseStart
        InsFmtText "Definitions" & vbCr, "IEEEStds Level 1 Header", wdCollapseEnd
        InsFmtText "For the purposes of this document, the following terms and definitions apply. " & _
            "The IEEE Standards Dictionary Online should be consulted for " & _
            "terms not defined in this clause.", "IEEEStds Paragraph", wdCollapseEnd
        .Collapse Direction:=wdCollapseEnd
        InsertRegularFootnote
        .TypeBackspace
        .Text = "The IEEE Standards Dictionary Online is available at:" & vbCr & "."
        .Collapse Direction:=wdCollapseEnd
        .Move Unit:=wdCharacter, Count:=-1
        .Hyperlinks.Add Anchor:=Selection.Range, _
            Address:="http://www.ieee.org/portal/innovate/products/standard/standards_dictionary.html", _
            TextToDisplay:="http://www.ieee.org/portal/innovate/products/standard/standards_dictionary.html"
        .MoveStart Unit:=wdCharacter, Count:=-79    'now fix hyperlink formatting
        .Style = "IEEEStds Footnote"
        .Font.Size = 8
        .Collapse wdCollapseStart
        .Move Unit:=wdCharacter, Count:=-18         'now fix book title formatting (x2)
        .MoveStart Unit:=wdCharacter, Count:=-60
        .Style = "IEEEStds AddItal"         'adds character formatting (italic) to default style (IEEEStds Footnote)
        myInitView.SeekView = wdSeekMainDocument    'get out of Footnote view
        .Move Unit:=wdCharacter, Count:=-58
        .MoveStart Unit:=wdCharacter, Count:=-60
        .Style = "IEEEStds AddItal"         'adds character formatting (italic) to default style (IEEEStds Paragraph)
        .Move Unit:=wdParagraph
    End With
End Sub
Sub AddAcknowledgments()
    If (MsgBox("Acknowledgments must appear in the front matter only.", vbOKCancel) = 1) Then
        Selection.Collapse Direction:=wdCollapseStart
        InsFmtText "Acknowledgments" & vbCr, "IEEEStds Level 1 (front matter)", wdCollapseEnd
        InsFmtText vbCr, "IEEEStds Paragraph", wdCollapseStart
    End If
End Sub
Sub AddReferences()
    add_references_head.Show
End Sub
Sub general_info()
    doc_info.Show vbModeless
End Sub
Sub InsertRegularFootnote()
    With ActiveDocument.Footnotes
        .Location = wdBottomOfPage
        .StartingNumber = 1
        .NumberStyle = wdNoteNumberStyleArabic
        .NumberingRule = wdRestartSection
    End With
    ActiveDocument.Footnotes.Add Range:=Selection.Range, Reference:=""
    Selection.Style = ActiveDocument.Styles("IEEEStds Footnote")
End Sub
Sub AddWarning()
    add_warning.Show vbModeless
End Sub
Sub InsertRegularTableCaption()
    CheckWhere
    InsFmtText Chr(151), "IEEEStds Regular Table Caption", wdCollapseEnd
End Sub
Sub InsertRegularFigureCaption()
    CheckWhere
    InsFmtText Chr(151), "IEEEStds Regular Figure Caption", wdCollapseEnd
End Sub
Sub InsertAnnexFigureCaption()
    CheckWhere
    AddCaption strType:="Figure"
End Sub
Sub InsertAnnexTableCaption()
    CheckWhere
    AddCaption strType:="Table"
End Sub
Sub InsertNewList()
Attribute InsertNewList.VB_Description = "Macro recorded 12/22/02 by user"
Attribute InsertNewList.VB_ProcData.VB_Invoke_Func = "IEEEStdsTemplate.NewMacros.Macro1"
Dim myList As ListFormat
    MsgBox "To build a multi-tiered list, apply list styles, or hit TAB to create next level, SHIFT+TAB to go back a level." & _
        vbCr & "To end the list, hit RETURN, and apply Body Text style."
    CheckWhere
    Selection.Style = ActiveDocument.Styles("IEEEStds Numbered List Level 1")
    Set myList = Selection.Range.ListFormat
    myList.ApplyListTemplate ListTemplate:=myList.ListTemplate, ContinuePreviousList:=False
End Sub
Sub InsertNewTable()
Attribute InsertNewTable.VB_Description = "Macro recorded 12/22/02 by user"
Attribute InsertNewTable.VB_ProcData.VB_Invoke_Func = "IEEEStdsTemplate.NewMacros.Macro1"
    add_table.Show
End Sub
Sub InsertNewEquation()
Attribute InsertNewEquation.VB_Description = "Macro recorded 12/22/02 by user"
Attribute InsertNewEquation.VB_ProcData.VB_Invoke_Func = "IEEEStdsTemplate.NewMacros.InsertNewEquation"
    add_equation.Show
End Sub
Sub DocInfoDesignation()
    InsCustField "varDesignation", Selection.Style
End Sub
Sub DocInfoDraftNumber()
    InsCustField "varDraftNumber", Selection.Style
End Sub
Sub DocInfoMonthOfDraft()
    InsCustField "varDraftMonth", Selection.Style
End Sub
Sub DocInfoYearOfDraft()
    InsCustField "varDraftYear", Selection.Style
End Sub
Sub DocInfooptTrialUseTitle()
    InsCustField "txtTrialUse \*Caps", Selection.Style
End Sub
Sub DocInfooptTrialUseLower()
    InsCustField "txtTrialUse \*Lower", Selection.Style
End Sub
Sub DocInfoGorRPorSTDTitle()
    InsCustField "txtGorRPorSTD \*Caps", Selection.Style
End Sub
Sub DocInfoGorRPorSTDLower()
    InsCustField "txtGorRPorSTD \*Lower", Selection.Style
End Sub
Sub DocInfoPAR()
    InsCustField "varTitlePAR", Selection.Style
End Sub
Sub DocInfoWorkingGroup()
    InsCustField "varWorkingGroup", Selection.Style
End Sub
Sub DocInfoCommittee()
    InsCustField "varCommittee", Selection.Style
End Sub
Sub DocInfoWkGrpChair()
    InsCustField "varWkGrpChair", Selection.Style
End Sub
Sub DocInfoWkGrpViceChair()
    InsCustField "varWkGrpViceChair", Selection.Style
End Sub
Sub InsertTOC()
Attribute InsertTOC.VB_Description = "Macro recorded 01/05/03 by user"
Attribute InsertTOC.VB_ProcData.VB_Invoke_Func = "IEEEStdsTemplate.NewMacros.InsertTOC"
    Selection.Find.ClearFormatting
    If Not (Selection.Find.Execute("<After draft body is complete, select this text and click Insert Special->Add (Table of) Contents>", , , , , , , wdFindContinue)) Then
        If (MsgBox("Cursor should be on the last page of the frontmatter section, just below the Contents header. Click Cancel to move cursor.", vbOKCancel) = 2) Then
            Exit Sub
        End If
    End If
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "TOC \h \z \t ""Heading 1,1,Heading 2,2,IEEEStds Level 1 Header,1,IEEEStds Level 2 Header,2""" _
        , PreserveFormatting:=True
End Sub
Public Function InsFmtText(strText As String, strStyle As String, varCollapse As Variant, Optional blnBold As Boolean, Optional blnItalic As Boolean, Optional blnStrike As Boolean, Optional blnUnder As Boolean)
    With Selection
        .Text = strText
        .Style = strStyle
        If (blnBold) Then .Font.Bold = True
        If (blnItalic) Then .Font.Italic = True
        If (blnStrike) Then .Font.StrikeThrough = True
        If (blnUnder) Then .Font.Underline = True
        .Collapse Direction:=varCollapse
    End With
End Function
Public Function AddCaption(strType As String)
Dim thisPosition
    If (strType = "Table") Then
        thisPosition = wdCaptionPositionAbove
    ElseIf (strType = "Figure") Then
        thisPosition = wdCaptionPositionBelow
    End If
    With CaptionLabels(strType)
        .NumberStyle = wdCaptionNumberStyleArabic
        .IncludeChapterNumber = True
        .ChapterStyleLevel = 1
        .Separator = wdSeparatorPeriod
    End With
    Selection.InsertCaption Label:=strType, Title:="—", _
        Position:=thisPosition
End Function
Public Function InsCustField(strFieldName_switches As String, Optional strStyle As String, Optional blnBold As Boolean, Optional blnItalic As Boolean)
    With Selection
        If Not (strStyle = "") Then .Style = strStyle
        If (blnBold) Then .Font.Bold = True
        If (blnItalic) Then .Font.Italic = True
        .Fields.Add Range:=.Range, Type:=wdFieldEmpty, Text:= _
            "DOCVARIABLE " & strFieldName_switches, PreserveFormatting:=True
    End With
End Function
Public Sub GoToURL(intWhere As Integer)
    Select Case intWhere
    Case 1      'IEEE Standards Style Manual
        ActiveDocument.FollowHyperlink Address:= _
            "http://standards.ieee.org/guides/style/", NewWindow:=True, AddHistory:=True
    Case 2      'PAR History Online
        ActiveDocument.FollowHyperlink Address:= _
            "http://standards.ieee.org/board/nes/approved.html", NewWindow:=True, AddHistory:=True
    Case 3      'Draft standards template document and documentation
        ActiveDocument.FollowHyperlink Address:= _
            "http://standards.ieee.org/resources/development/writing/templates.html", NewWindow:=True, AddHistory:=True
    Case 4      'IEEE Standards Main
        ActiveDocument.FollowHyperlink Address:= _
            "http://standards.ieee.org/", NewWindow:=True, AddHistory:=True
    Case 5      'IEEE main
        ActiveDocument.FollowHyperlink Address:= _
            "http://www.ieee.org/", NewWindow:=True, AddHistory:=True
    End Select
End Sub
Sub ResetToNew()
Dim strMsg As String
    strMsg = "The next time this document is opened, the Welcome and Required Info screens will appear." + vbCr + "Document text will remain unchanged."
    If (MsgBox(strMsg, vbOKCancel, "Reset Document Display") = vbOK) Then
        ActiveDocument.Variables.Item("IsNew").Value = "Y"
    End If
End Sub
Public Sub ShowFields()
    ActiveWindow.View.FieldShading = wdFieldShadingAlways
End Sub
Public Sub HideFields()
    ActiveWindow.View.FieldShading = wdFieldShadingNever
End Sub
Public Sub UpdateAllFields()
'handles up to 3 correcting manual (soft) returns in a field
'check if temp vars exist with ChkUseFF, at end of this sub
Dim TOC As TableOfContents, myF As Field, rngS As Range, lngPos1 As Long, lngPos2 As Long, lngPos3 As Long
Dim myView As View
    Set rngS = Selection.Range  'mark start pos of cursor
    Set myView = ActiveDocument.ActiveWindow.View   'mark starting view
'update headers/footers: if fn is called from final status form, then add "T" to variable name with ChkUseFF
    If Not (MakeHeaderFooter(ActiveDocument.Variables(ChkUseFF & "varDraftFinal").Value)) Then: MsgBox "Headers and footers were not updated.", , "Warning!"
        'Note that error message is not shown if StopHeaderUpdates is "True"
    ActiveDocument.Footnotes(1).Range.Fields.Update 'update fields in copyright footer
    For Each myF In ActiveDocument.Fields   'update body text fields
        myF.Select
        Select Case myF.Type
            Case wdFieldHyperlink, wdFieldTOC, wdFieldTOCEntry, wdFieldPageRef
                'hyperlinks are edited directly, TOC/page refs are updated by TOC (below)
                GoTo NextOne
            Case Else
                If (ActiveDocument.Variables("StopUpdateTitles").Value = "True") Then   'if set to true, skip main titles
                    If (Selection.Style = "IEEEStds Title") Then: GoTo NextOne
                End If
            'only look for manual returns Chr(11), if one found then check for the next, up to 3
            'if field is updated, returns may end up in the wrong place
                If (InStr(Selection.Text, Chr(11))) Then
                    lngPos1 = InStr(Selection.Text, Chr(11))
                    lngPos2 = InStr(lngPos1 + 1, Selection.Text, Chr(11))
                    If (lngPos2 > 0) Then
                        lngPos3 = InStr(lngPos2 + 1, Selection.Text, Chr(11))
                    End If
                    myF.Select
                    myF.Update
                    Selection.Collapse Direction:=wdCollapseStart
                    Selection.MoveRight Unit:=wdCharacter, Count:=(lngPos1 - 1)
                    Selection.InsertAfter Chr(11)
                    lngPos1 = 0
                    If (lngPos2 > 0) Then
                        myF.Select
                        Selection.Collapse Direction:=wdCollapseStart
                        Selection.MoveRight Unit:=wdCharacter, Count:=(lngPos2 - 1)
                        Selection.InsertAfter Chr(11)
                        lngPos2 = 0
                        If (lngPos3 > 0) Then
                            myF.Select
                            Selection.Collapse Direction:=wdCollapseStart
                            Selection.MoveRight Unit:=wdCharacter, Count:=(lngPos3 - 1)
                            Selection.InsertAfter Chr(11)
                            lngPos3 = 0
                        End If
                    End If
                Else: myF.Update    'if lngPos is 0 (no xtra returns) then just update
                End If
        End Select
NextOne:
    Next myF
    For Each TOC In ActiveDocument.TablesOfContents 'updates table of contents (field)
        TOC.Update
        TOC.UpdatePageNumbers
    Next TOC
    myView.SeekView = wdSeekMainDocument
    rngS.Select
End Sub
Function ChkUseFF() As String
Dim myVar As Variable, Num As Long
    For Each myVar In ActiveDocument.Variables  'Check for existence of one temp variable to show that final status form was used
        If myVar.Name = "TvarDraftFinal" Then Num = myVar.Index
    Next myVar
    If (Num > 0) Then
        ChkUseFF = "T"   'If fn is called during draft/final status change, then Return "T" as prefix for (temp) vars
    Else: ChkUseFF = ""
    End If
End Function
Function MakeHeaderFooter(myState As String)
'Updates the header and footer, no fields besides page numbering permitted in header/footer
Dim mySection As Section, myHeadStr As String, myFootStr As String, myDate As String, myRange As Range, myCount As Integer
Dim myHF As HeaderFooter, mySel As Selection, PrFx As String, myTitlePgHeadStr As String, myViewType As Variant
Dim rngPageOne As Range, POneSectTwo As Integer, POneSectOne As Integer, FMLstSect As Integer
    MakeHeaderFooter = False
    myViewType = ActiveWindow.ActivePane.View.Type
'Add headers and footers based on draft or final status
    PrFx = ChkUseFF 'If MakeHeaderFooter fn is called from draft/final status change, then use temp vars: add "T" to all var names
    'the following code is a loose fix to changing sections in frontmatter
    'looks for a bookmark at 'IMPORTANT NOTICE', showing the start of main body
    'is at Section (of the bookmark) minus 1, end of frontmatter is minus 2
    Set rngPageOne = ActiveDocument.Bookmarks("PageOne").Range
    POneSectTwo = rngPageOne.Information(wdActiveEndSectionNumber)
    POneSectOne = POneSectTwo - 1
    FMLstSect = POneSectTwo - 2
    Select Case myState
        Case "Draft"
            GoSub DeleteHeadersFooters
        'add draft headers, same for whole doc
            With ActiveDocument
                myHeadStr = "P" & .Variables("varDesignation").Value & "/D" & .Variables("varDraftNumber").Value & _
                    ", " & .Variables("varDraftMonth").Value & " " & .Variables("varDraftYear").Value & vbCr & _
                    "Draft" & .Variables("txtTrialUse").Value & .Variables("txtGorRPorStd").Value & " for " & _
                    .Variables("varTitlePAR").Value
            End With
            For Each mySection In myRange.Sections
                mySection.Headers(wdHeaderFooterPrimary).Range.Text = myHeadStr
                mySection.Headers(wdHeaderFooterPrimary).Range.Style = "Header"
…