Proofreader Marks Add-In
(A Microsoft Word Help & Tip page by Gregory K. Maxey)

<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="Onload">
 <ribbon>
  <tabs>
   <tab idMso="TabAddIns">
    <group id="Grp1" label="Proofreading">
     <toggleButton id="TB1" size="large" getLabel="GetLabel"
        getPressed="GetPressed" getImage="GetImage" onAction="ToggleOnActionMacro"/>
     <dropDown id="DD1" label="Proofreading Marks" getItemCount="GetItemCount" getItemLabel="GetItemLabel"
         getItemScreentip="GetItemScreenTip" getItemSupertip="GetItemSuperTip" getSelectedItemIndex="GetSelectedItemIndex"
         onAction="MyDDMacro">
     </dropDown>
    </group>
   </tab>
  </tabs>
 </ribbon>
</customUI>

Option Explicit
Public myRibbon As IRibbonUI
Private myArrayPri() As String 'This array holds the label text
Private myArraySec() As String 'This array holds the pre-defined comment text
Private myArrayTri() As String 'This array holds the screentip text 
Private oDocTemp As Word.Document 
Private pImage As String
Private bLabelState As Boolean

'This procedure creates a ribbon object for the project
Sub Onload(ribbon As IRibbonUI)
  Set myRibbon = ribbon
End Sub

'This procedure and the succeeding three functions loads the data from the data store into the arrays. When the AddIn loads a new temporary document containing the data store table is created. The data in the table is passed as a variable to the three functions which loads the arrays. 
Sub LoadArrays()
Dim aTemplate As Template
Dim oDoc As Word.Document
Dim oTbl As Table
  bLabelState = True
  For Each aTemplate In Templates
    'Change this line if you use a different name for your template 
    If aTemplate.Name = "Proofreading Marks AddIn.dotm" Then
      'Open the temporary document. 
      Set oDoc = Documents.Add(aTemplate.FullName, , , False)
      Set oTbl = oDoc.Tables(1)
      myArrayPri() = GetLabelArray(oTbl)
      myArraySec() = GetCommentArray(oTbl)
      myArrayTri() = GetScreenTipArray(oTbl)
      'Close the temporary document.
      oDoc.Close wdDoNotSaveChanges
      Exit For
    End If
  Next
End Sub
 
Function GetLabelArray(ByVal oTbl As Table) As String()
Dim i As Long
Dim tempArray() As String
  ReDim tempArray(oTbl.Rows.count)
  'Loop through the column 1 rows putting the content of each cell in the array.
  For i = 1 To oTbl.Rows.count
    tempArray(i - 1) = Left(oTbl.Cell(i, 1).Range.Text, Len(oTbl.Cell(i, 1).Range.Text) - 2)
  Next i
  GetLabelArray = tempArray
End Function

Function GetCommentArray(ByVal oTbl As Table) As String()
Dim i As Long
Dim tempArray() As String
  ReDim tempArray(oTbl.Rows.count)
  'Loop through the column 2 rows putting the content of each cell in the array.
  For i = 1 To oTbl.Rows.count
    tempArray(i - 1) = Left(oTbl.Cell(i, 2).Range.Text, Len(oTbl.Cell(i, 2).Range.Text) - 2)
  Next i
  GetCommentArray = tempArray
End Function

Function GetScreenTipArray(ByVal oTbl As Table) As String()
Dim i As Long
Dim tempArray() As String
  ReDim tempArray(oTbl.Rows.count)
  'Loop through the column 3 rows putting the content of each cell in the array.
  For i = 1 To oTbl.Rows.count
    tempArray(i - 1) = Left(oTbl.Cell(i, 3).Range.Text, Len(oTbl.Cell(i, 3).Range.Text) - 2)
  Next i
  GetScreenTipArray = tempArray
End Function

'This callback provides the number of items in the dropdown. The number of items is determined by the 
'number of labels contained in the label array. 
Sub GetItemCount(ByVal control As IRibbonControl, ByRef count)
  On Error Resume Next
  If IsNull(myArrayPri(0)) Then
    LoadArrays
  End If
  On Error GoTo 0
  Select Case control.id
    Case "DD1"
      count = UBound(myArrayPri)
    Case Else
      'Do Nothing
  End Select
End Sub

'This callback provides the label for each item in the dropdown. Since it is called once for each item in the dropdown, we simply set the label to the corresponding item in the array containing the label data.
Sub GetItemLabel(ByVal control As IRibbonControl, Index As Integer, ByRef label)
  Select Case control.id
    Case "DD1"
      label = myArrayPri(Index)
    Case Else
      'Do nothing
  End Select
End Sub

'This callback sets the displayed item in the dropdown control. 
Sub GetSelectedItemIndex(ByVal control As IRibbonControl, ByRef Index)
  Select Case control.id
    Case "DD1"
      Index = 0
    Case Else
      'Do nothing
  End Select
End Sub

'This callback provides the screentip for each item in the dropdown. Again, since it is called once for each item in the dropdown, we simply set the screentip text to the corresponding item in the array.
Sub GetItemScreenTip(ByVal control As IRibbonControl, Index As Integer, ByRef screentip)
  Select Case control.id
    Case "DD1"
      screentip = myArrayTri(Index)
    Case Else
      'Do nothing
  End Select
End Sub

Sub GetItemSuperTip(ByVal control As IRibbonControl, Index As Integer, ByRef supertip)
  Select Case control.id
    Case "DD1"
       supertip = myArraySec(Index)
    Case Else
      'Do nothing
  End Select
End Sub

'This is the dropdown control onAction callback. It is the workhorse of this project or the procedure that actually does something in the document. The first thing it does is declare a Userform object. The Userform provides the user interface to display the pre-defined comment text and offer the user the opportunity to edit the comment text. The Userform and code are shown following this discussion.
Sub MyDDMacro(ByVal control As IRibbonControl, selectedId As String, selectedIndex As Integer)
Dim oFrm As Userform1
Dim pUserInt As String
  Select Case control.id
    Case "DD1"
      'Cancel action if no document is open.
      If Documents.count < 1 Then
        myRibbon.InvalidateControl control.id
        Exit Sub
      End If
      'Notify user to select text prior to making an annotations
      If Selection.Type = wdSelectionIP Or wdNoSelection Then
        MsgBox "Please select the proofreading error in the text before inserting comments."
        myRibbon.InvalidateControl control.id
        Exit Sub
      End If
      Select Case selectedIndex
        Case Is = 0
          'Do Nothing
        Case Else
          'Capture the user's initials
          pUserInt = Application.UserInitials
          Set oFrm = New Userform1
          'Write the pre-defined comment text in the Userform textbox.
          oFrm.TextBox1 = myArraySec(selectedIndex)
          With oFrm.TextBox1
           .SetFocus
           .SelStart = 0
           .SelLength = Len(.Text)
          End With
          oFrm.Show
          'Insert the comment in the document.
          If oFrm.Tag = 1 Then
            'Set the user initials = to the annotation
            On Error GoTo Err_Handler
            Application.UserInitials = myArrayPri(selectedIndex)
            On Error GoTo 0
            Selection.Comments.Add Selection.Range, oFrm.TextBox1.Text
          End If
          Unload oFrm
          Set oFrm = Nothing
          'Restore the user initials
          Application.UserInitials = pUserInt
          myRibbon.InvalidateControl control.id
      End Select
    Case Else
      'Do Nothing
  End Select
  Exit Sub
Err_Handler:
  If Err.Number = 4609 Then
    'Label was longer than 9 characters. Truncate annotation in document.
    Application.UserInitials = Left(myArrayPri(selectedIndex), 9)
    Resume Next
  End If
End Sub

'This callback defines the image displayed on the toggle button control.
Sub GetImage(control As IRibbonControl, ByRef image)
  Select Case control.id
    Case "TB1"
      If pImage = "" Then pImage = "FileOpen"
      image = pImage
    Case Else
      'Do Nothing
  End Select
End Sub

'This callback defines the label displayed on the toggle button control.
Sub GetLabel(ByVal control As IRibbonControl, ByRef label)
 Select Case control.id
   Case "TB1"
     If bLabelState Then
       label = "Edit Proofreading Marks List"
     Else
        label = "Save changes"
     End If
  Case Else
    'Do Nothing
  End Select
End Sub

'This callback sets the state of the displayed toggle button. (i.e., button flush or button depressed)
Sub GetPressed(control As IRibbonControl, ByRef returnValue)
  Select Case control.id
    Case "TB1"
      If pImage = "" Then pImage = "FileOpen"
      If pImage = "FileOpen" Then
        returnValue = False
      Else
        returnValue = True
      End If
    Case Else
      'Do nothing
  End Select
End Sub

'This is the toggle button control onAction callback.
Sub ToggleOnActionMacro(ByVal control As IRibbonControl, bToggled As Boolean)
  'User clicks to edit the list.
  If bToggled Then
    'Defined new image
    pImage = "FileClose"
    'Call procedure to open the data store for editing.
    EditPRMarks
    'Repopulate the arrays.
    LoadArrays
    bLabelState = False
    'User clicks to Save changes.
  Else
    pImage = "FileOpen"
    'Call procedure to save and close the data store.
    SavePRMarksChanges
    bLabelState = True
  End If
  myRibbon.InvalidateControl control.id
  myRibbon.Invalidate
End Sub

'Procedure to open the data store for editing.
Sub EditPRMarks()
Dim aTemplate As Template
Dim oTbl As Table
  For Each aTemplate In Templates
    'Change this line if you use a different name for your template 
    If aTemplate.Name = "Proofreading Marks AddIn.dotm" Then
      Set oDocTemp = aTemplate.OpenAsDocument
    End If
    Exit For
  Next
End Sub

'Procedure for saving changes to the data store.
Sub SavePRMarksChanges()
Dim oTbl As Table
  If Not oDocTemp Is Nothing Then
    With oDocTemp
      Set oTbl = .Tables(1)
      myArrayPri() = GetLabelArray(oTbl)
      myArraySec() = GetCommentArray(oTbl)
      myArrayTri() = GetScreenTipArray(oTbl)
      .Save
      .Close
    End With
  End If
End Sub

Option Explicit
Private Sub CommandButton1_Click()
  Me.Tag = 1
  Me.Hide
End Sub

Private Sub CommandButton2_Click()
  Me.Tag = 0
  Me.Hide
End Sub