John Miyamoto
Word Macro Code, 1/11/2007

*********** 'My' module in JMM.DOT **************
'==========================================================
Public Sub AddBookmark(NewBookmark As String)
'
' AddBookmark Macro
' Add bookmark to current document
'
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=NewBookmark
End Sub
'==========================================================
Public Sub AscNum()
' Gives the Ascii code and the Ascii W code for selected character.
MsgBox ("Ascii number for the highlighted character is:  " & Asc(Selection.Text))
MsgBox ("Ascii W number for the highlighted character is:  " & AscW(Selection.Text))
End Sub
'=========================================================
Sub AddEdit()
'
' AddEdit Macro
' Attach 'edit.dot' template as an AddIn.
'
    AddIns.Add FileName:="E:\cm\templats\Edit.dot", Install:=True
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "E:\cm\templats\jmm.dot"
        .XMLSchemaReferences.AutomaticValidation = True
        .XMLSchemaReferences.AllowSaveAsXMLWithoutValidation = False
    End With
End Sub
'========================================================
Sub AddR()
'
'   AddR Macro
'   The AddR macro attaches R.Dot as an AddIn.
'
    AddIns("D:\Program Files\MathType50\Office Support\WordCmds.dot"). _
        Installed = False
    AddIns("E:\PDFMaker.dot").Installed = False
    AddIns("E:\NORMAL.DOT").Installed = False
    AddIns("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\STARTUP\WordSmith.dot"). _
        Installed = False
    AddIns("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\STARTUP\PALMAPP.DOT"). _
        Installed = False
    AddIns("E:\cm\templats\r.dot").Install = True
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "E:\cm\templats\jmm.dot"
    End With
End Sub
'==============================
Sub assignkey()
'   Assigns a macro to Ctrl-Shift-J.  Ok 3/19/01.
    macname$ = InputBox("Assign Macro to Hot Key", "Input macro name", "")
    KeyChoice = InputBox("Indicate the key to be used as your hot key.  Your choices are:" & Chr(13) & _
        "1  ==  Ctrl-Shift-J   (currently unassigned)" & Chr(13) & _
        "2  ==  Ctrl-,   (currently assigned to prefix key)" & Chr(13) & _
        "3  ==  Ctrl-.   (currently unassigned)" & Chr(13) & _
        "4  ==  Ctrl-/   (currently assigned to prefix key)" & Chr(13) & _
        "5  ==  Ctrl-Shift-?   (currently unassigned)", "Assign Hot Key")

    If (KeyChoice = 1) Then
        CustomizationContext = ActiveDocument.AttachedTemplate
        KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyJ, wdKeyControl, wdKeyShift), _
            KeyCategory:=wdKeyCategoryMacro, Command:=macname$
        End If

    If (KeyChoice = 2) Then
        CustomizationContext = ActiveDocument.AttachedTemplate
        KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyComma, wdKeyControl), _
            KeyCategory:=wdKeyCategoryMacro, Command:=macname$
        End If
        
    If (KeyChoice = 3) Then
        CustomizationContext = ActiveDocument.AttachedTemplate
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeyPeriod, wdKeyControl), _
        KeyCategory:=wdKeyCategoryMacro, Command:=macname$
    End If
        
    If (KeyChoice = 4) Then
        CustomizationContext = ActiveDocument.AttachedTemplate
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySlash, wdKeyControl), _
        KeyCategory:=wdKeyCategoryMacro, Command:=macname$
    End If
        
    If (KeyChoice = 5) Then
        CustomizationContext = ActiveDocument.AttachedTemplate
        KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySlash, wdKeyControl, wdKeyShift _
            ), KeyCategory:=wdKeyCategoryMacro, Command:=macname$
        End If

End Sub
'==============================
Sub AttachNormal()
'
' AttachNormal Macro
' Attach normal template to current document
'
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "E:\cm\TEMPLATS\Normal.dot"
    End With
End Sub
'======================================================
Sub big()
'
' tmbig Macro
' Attach bigfont.dot and makes jmm.dot an add-in.
'
    AddIns("E:\PDFMaker.dot").Installed = False
    AddIns("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\STARTUP\WordSmith.dot"). _
        Installed = False
    AddIns("C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE\STARTUP\PALMAPP.DOT"). _
        Installed = False
    AddIns("E:\cm\templats\JMM.DOT").Installed = True
End Sub
'======================================================
Public Sub BlankToTab()
' Macro 'BlankToTab' replaces every sequence of consecutive blanks with one tab.
Dim CountVar As Integer
Dim bs1 As String, bs2 As String
Dim BlanksNotFound As Boolean

AddBookmark ("tmInitial")
CountVar = 0
bs1 = ""

Do
    bs1 = bs1 & "     "
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = bs1
        .Replacement.Text = ""
        .Forward = True     'Direction choices:  True, False
        .Wrap = wdFindStop      'Wrap choices: wdFindContinue, wdFindAsk, wdFindStop
        .MatchCase = False
        .MatchWholeWord = False
        .Format = False
    End With
    Selection.Find.Execute
    BlanksNotFound = Not Selection.Find.Found
    GoToBook ("tmInitial")
Loop Until BlanksNotFound

CountVar = Len(bs1)
bs2 = bs1

For I = 1 To (CountVar - 1)
    bs2 = Left(bs1, CountVar - I)

    GoToBook ("tmInitial")
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = bs2
        .Replacement.Text = Chr(9)
        .Forward = True     'Direction choices:  True, False
        .Wrap = wdFindStop
        .MatchCase = False
        .MatchWholeWord = False
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
Next
End Sub     'end def 'BlankToTab'

'======================================================
Sub bnd()
'   Put border around figure or paragraph.
    With Selection.ParagraphFormat
        With .Borders(wdBorderLeft)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .ColorIndex = wdAuto
        End With
        With .Borders(wdBorderRight)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .ColorIndex = wdAuto
        End With
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .ColorIndex = wdAuto
        End With
        With .Borders(wdBorderBottom)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth050pt
            .ColorIndex = wdAuto
        End With
    End With
End Sub
'==============================
Sub box()
'
' box Macro
' Put box around highlighted text
'
    With Selection.Font
        With .Borders(1)
            .LineStyle = wdLineStyleSingle
            .LineWidth = wdLineWidth100pt
            .Color = wdColorAutomatic
        End With
        .Borders.Shadow = False
    End With
    With Options
        .DefaultBorderLineStyle = wdLineStyleSingle
        .DefaultBorderLineWidth = wdLineWidth100pt
        .DefaultBorderColor = wdColorAutomatic
    End With
End Sub
'===========================================================
Public Sub Cap()
Dim NumChars As Integer
Dim AskBeforeCap As Boolean, CapDecis As Boolean, IsFontItalicized As Boolean
Dim aa1 As String, bb1 As String

AddBookmark ("tmCurrentSelection")
NumChars = Selection.Characters.Count

AskBeforeCap = (MsgBox( _
    "Ask the user whether to capitalize a letter, or make capitalization decisions automatically?" & _
    Chr(13) & Chr(13) & _
    "YES = Ask before each capitalization action,   NO = Automatically capitalize 1st letters of words", _
    vbYesNo, "Automatic or User-Controlled Capitalization?") = vbYes)

Selection.EscapeKey
Selection.Collapse

For I = 1 To NumChars - 2
    CapDecis = True
    If I > 2 Then
        Selection.EscapeKey
        Selection.Collapse
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        aa1 = Selection.Text
    End If     'end "If I > 2"
    
    If I = 2 Then
        Selection.EscapeKey
        Selection.Collapse
        Selection.MoveLeft Unit:=wdCharacter, Count:=1
        Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        aa1 = Selection.Text
    End If
    
    If I = 1 Then aa1 = " "
    
    SelectNextChar
    bb1 = Selection.Text
    
    If (aa1 = " " Or aa1 = Chr(13) Or aa1 = Chr(11) Or aa1 = "(" Or Is_Dash(aa1)) And _
        Is_Lower(bb1) Then

        If AskBeforeCap Then
            BoxRes = MsgBox( _
                "Capitalize the selected character?" & Chr(13) & Chr(13) & _
                "YES = Capitalize,     NO = Don't capitalize,     CANCEL = Exit macro", vbYesNoCancel)
            If BoxRes = vbCancel Then End
            CapDecis = (BoxRes = vbYes)
        End If      'end "If AskBeforeCap"
        
        If CapDecis Then
            IsFontItalicized = Selection.Font.Italic
            Selection.Delete Unit:=wdCharacter, Count:=1
            Selection.Font.Italic = IsFontItalicized
            Selection.TypeText Text:=UCase(bb1)
            If I = NumChars - 2 Then
                SelectToBookmark ("tmCurrentSelection")
                AddBookmark ("tmCurrentSelection")
            End If     'end "If I = NumChars - 2"
        End If      'end "If CapDecis
    End If      'end "If (aa1 = " " Or aa1 = Chr(13) Or aa1 = Chr(11) Or aa1 = "(") And Is_Lower(bb1) "
    
    Selection.EscapeKey
    Selection.MoveRight Unit:=wdCharacter, Count:=1

Next I     'end 'For I = 1 to NumChars - 2

Selection.EscapeKey
GoToBook ("tmCurrentSelection")
End Sub     'end def 'cap'
'===========================================================
Public Sub Char()
cc1% = InputBox("Look up character that corresponds to number:  ")
' MsgBox ("Characters =  '" & Chr(cc1%) & "'")
Selection.TypeText Text:=Chr(cc1%)
End Sub
'===========================================================
Sub ClipList()
'   Shows the toolbar with the list of clipboard contents.  Ok 3/19/01.
    CommandBars("Clipboard").Visible = True
End Sub
'===========================================================
Sub cnvtab()
'   Converts a table to text.  Fields separated by commas.  Ok 3/19/01.
    Selection.Tables(1).Select
    Selection.Rows.ConvertToText Separator:=wdSeparateByCommas, NestedTables:= _
        True
    Selection.Fields.Unlink
End Sub
'===========================================================
Sub ColWidth()
'   Assign column width to column containing current cursor position.
'   Revised 3/18/01
    Application.Run MacroName:="SelectColumn"
    tmx = PointsToInches(Selection.Columns.Width)
    CW$ = InputBox("Input column width, e.g., 1.0", _
        "Input Column Width", Str(tmx))
    If CW$ = "auto" Then
        Selection.Cells.SetWidth ColumnWidth:=wdAutoPosition _
            , RulerStyle:=wdAdjustNone
    Else
        Selection.Cells.SetWidth ColumnWidth:=InchesToPoints(Val(CW$)) _
            , RulerStyle:=wdAdjustNone
    End If
End Sub
'===========================================================
Sub del_linefeed()
'
' 'del_linefeed' macro replaces line feeds with commas.
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " ^l"
        .Replacement.Text = ", "
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " ^l"
        .Replacement.Text = ", "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = ", "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
'====================================================
Sub dlf()
'   Delete line feeds; replace with comma.
    Application.Run MacroName:="del_linefeed"
End Sub
'==============================================================
Sub DelEditMacs()
'
' DelEditMacs Macro
' Delete the Edit.Dot macros from the current document
'
    Application.DisplayAutoCompleteTips = True
    NormalTemplate.AutoTextEntries("Filename and path").Insert Where:= _
        Selection.Range, RichText:=True
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.Fields.Unlink
    docloc$ = Selection.Text
    Selection.Delete Unit:=wdCharacter, Count:=1
    Application.OrganizerDelete Source:=docloc$, Name:="EditMacs", _
        Object:=wdOrganizerObjectProjectItems
End Sub
'=====================================================
Sub DelOptionalHyphen()
' Macro deletes all optional hyphens within a selection or from the current cursor
' position to the end of the file if no selection has been made.
'
    CurrentDisplay = ActiveWindow.View.ShowAll
    ActiveWindow.View.ShowAll = True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^-"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = False
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.View.ShowAll = CurrentDisplay
End Sub
'=====================================================
Sub delpara()
'   Delete paragraph marks to reformat email messages.
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^l"
        .Replacement.Text = ", ^p"
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p  "
        .Replacement.Text = "@#@"
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   ********
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p^p"
        .Replacement.Text = "@#@"
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   ********
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = " ^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   ********
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'   ********
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "@#@"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
'=================================================================
Sub delrep()
'
' delrep Macro
' Repeat search, query,and if yes, delete and replace with content of clipboard.
'
    Selection.Find.Execute
'
    If MsgBox("Delete this text?", vbYesNo) = vbYes Then
        Selection.Delete Unit:=wdCharacter, Count:=1
        Application.Run MacroName:="MathTypeCommands.UIWrappers.EditPaste"
    End If
End Sub
'================================================================
Sub eq2()
' Insert Version 3.0 Equation Object.  Ok 3/19/01.
    Selection.InlineShapes.AddOLEObject ClassType:="Equation.3", FileName:="", _
         LinkToFile:=False, DisplayAsIcon:=False
End Sub
'==============================
Sub f()
'
' f Macro
' Improved search procedure
'
SString$ = InputBox("Enter search string")

SearchType$ = InputBox("Enter search type" & Chr(13) & Chr(13) & _
    "1xxx = +forward,   2xxx = -forward" & Chr(13) & _
    "x1xx = +wrap,   x2xx = -wrap,  w3xx = Ask" & Chr(13) & _
    "xx1x = +match case,   xx2x = -match case" & Chr(13) & _
    "xxx1 = +whole word,   xxx2 = -whole word", "Search", "1222")

cc1$ = Mid(SearchType$, 1, 1)
cc2$ = Mid(SearchType$, 2, 1)
cc3$ = Mid(SearchType$, 3, 1)
cc4$ = Mid(SearchType$, 4, 1)

If (cc1$ = "1") Then
    Flag1 = True
    Else
        If (cc1$ = "2") Then
            Flag1 = False
        Else
            MsgBox ("Error: Illegal digit 1.  Input code was  '" & SearchType$ & "'")
            Exit Sub
        End If
End If
If (cc2$ = "1") Then
    Flag2 = wdFindContinue
    Else
        If (cc2$ = "2") Then
            Flag2 = wdFindStop
        Else
            If (cc2$ = "3") Then
                Flag2 = wdFindAsk
            Else
                MsgBox ("Error: Illegal digit 2.  Input code was  '" & SearchType$ & "'")
                Exit Sub
            End If
        End If
End If
If (cc3$ = "2") Then
    Flag3 = False
    Else
        If (cc3$ = "1") Then
            Flag3 = True
        Else
            MsgBox ("Error: Illegal digit 3.  Input code was  '" & SearchType$ & "'")
            Exit Sub
        End If
End If
If (cc4$ = "1") Then
    Flag4 = True
    Else
        If (cc4$ = "2") Then
            Flag4 = False
        Else
            MsgBox ("Error: Illegal digit 4.  Input code was  '" & SearchType$ & "'")
            Exit Sub
        End If
End If

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = SString$
        .Forward = Flag1
        .Wrap = Flag2
        .Format = False
        .MatchCase = Flag3
        .MatchWholeWord = Flag4
    End With
    Selection.Find.Execute
If (Not Selection.Find.Found) Then MsgBox ("String  '" & SString$ & "'  not found." & _
    Chr(13) & Chr(13) & ".Forward = " & Flag1 & Chr(13) & ".Wrap = " & Flag2 & _
    Chr(13) & ".MatchCase = " & Flag3 & Chr(13) & ".MatchWholeWord = " & Flag4)
End Sub
'=====================================
Sub fot()
'   (Re)format styles ot1 and ot2 to conform to JMM.DOT.  Ok 3/19/01.
    Application.OrganizerCopy Source:="E:\cm\templats\save\jmm.z060331.dot", _
        Destination:=ActiveDocument.FullName, Name:="ot1", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\save\jmm.z060331.dot", _
        Destination:=ActiveDocument.FullName, Name:="ot2", Object:= _
        wdOrganizerObjectStyles
End Sub
'==============================
Sub fw()
'   FW formats graphics object to have a user selected width and
'   a height that preserves the original width to height ratio.
'   Revised 3/19/01.
    tmw0 = InputBox("Input desired width in inches." & _
        vbCr & "Height will remain proportional to selected width.", _
        "Format Size of Object", "3")
    tmw = 72 * tmw0
    Selection.InlineShapes(1).LockAspectRatio = msoTrue
    Selection.InlineShapes(1).Height = _
        Selection.InlineShapes(1).Height * (tmw / Selection.InlineShapes(1).Width)
    Selection.InlineShapes(1).Width = tmw
End Sub
'===========================================================
Sub GetEditMacs()
'
' GetEditMacs Macro
' Copy Edit.dot macros to current document
'
    Application.DisplayAutoCompleteTips = True
    NormalTemplate.AutoTextEntries("Filename and path").Insert Where:= _
        Selection.Range, RichText:=True
    Selection.MoveLeft Unit:=wdWord, Count:=1
    Selection.Fields.Unlink
    docloc$ = Selection.Text
    Selection.Delete Unit:=wdCharacter, Count:=1
    Application.OrganizerCopy Source:="E:\cm\templats\Edit.dot", _
        Destination:=docloc$, Name:="EditMacs", Object:= _
        wdOrganizerObjectProjectItems
End Sub
'================================================================
Public Sub GoToBook(ByVal sss As String)
If Not ActiveDocument.Bookmarks.Exists(sss) Then
    MsgBox ("GoToBook is attempting to find the bookmark:  '" & sss & "'" & Chr(13) & _
        "but this bookmark does not exist.")
End If
Selection.GoTo What:=wdGoToBookmark, Name:=sss
End Sub
'===========================================================
Sub GoToNu()
' GoTo Macro with input box.
' New GoTo function
'
    Target = InputBox("Bookmark to Go To:", _
        "Bookmark", "curr")
    Selection.GoTo What:=wdGoToBookmark, Name:=Target
End Sub
'============================================================
Sub h()
'   h Macro
'   Hides the selected text.
    Selection.Style = ActiveDocument.styles("h,hidden")
End Sub
'=============================================================
Sub h2()
'
' h2 Macro
' Create an h2 style paragraph that starts with a sequence number.
'
    Selection.Style = ActiveDocument.styles("Heading 2,h2,h2a")
    Application.Run MacroName:="TP.my.ii"
    Selection.TypeBackspace
    Selection.TypeText Text:=". "
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="tmc"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    tmtitle = InputBox("Text for this item/section.", "Input Text", "text")
    Selection.TypeText Text:=tmtitle
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="tmc"
    Selection.Copy
End Sub
'=============================================================
Sub hh()
' hh Macro
' Insert code for hidden text
' Note the 'odot' character has Ascii code = 63 and the 'dot' character has Ascii code = 183
    ActiveDocument.AttachedTemplate.AutoTextEntries("odot").Insert Where:=Selection.Range, _
        RichText:=True
    Selection.TypeText Text:="  "
    ActiveDocument.AttachedTemplate.AutoTextEntries("dot").Insert Where:=Selection.Range, _
        RichText:=True
    Selection.TypeText Text:=" "
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    ActiveWindow.View.ShowHiddenText = True
    Selection.Style = ActiveDocument.styles("hid.num,hh")
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 8
        .Position = 1
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=2
End Sub
'========================================================
Sub helpfields()
'   Loads help document re fields.  Revised 3/19/01.
    Documents.Open FileName:="E:\cm\WD_FIELD.DOC"
End Sub
'==============================
Sub hhn()
'
' show hh Macro
' Show 'hid.num' text
'
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "E:\cm\TEMPLATS\jmm-show.dot"
        .XMLSchemaReferences.AutomaticValidation = True
        .XMLSchemaReferences.AllowSaveAsXMLWithoutValidation = False
    End With
End Sub
'==============================
Sub idate()
'
' idate Macro
' Insert date with Month Day, Year format
'
    Selection.InsertDateTime DateTimeFormat:="MMMM d, yyyy", InsertAsField:= _
        False, DateLanguage:=wdEnglishUS, CalendarType:=wdCalendarWestern, _
        InsertAsFullWidth:=False
End Sub
'==============================
Sub idectab()
'   Insert decimal tab.  Ok 3/18/01.
    tabloc = InputBox("Input tab location, e.g., .4", "Input Tab Location", ".4")
    Selection.ParagraphFormat.TabStops.ClearAll
    ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(tabloc), _
        Alignment:=wdAlignTabDecimal, Leader:=wdTabLeaderSpaces
    ActiveWindow.ActivePane.DisplayRulers = True
End Sub
'==============================
Sub idt()
' idt Macro
' Insert date and time
'
    Selection.InsertDateTime DateTimeFormat:="M/d/yyyy h:mm am/pm", _
        InsertAsField:=False, DateLanguage:=wdEnglishUS, CalendarType:= _
        wdCalendarWestern, InsertAsFullWidth:=False
End Sub
'==============================
Sub ieq()
' Insert equation number field and bookmark.  Revised 3/16/01.
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    bkmk = InputBox("Bookmark", "Input Equation Number", "# only")
Do While ActiveDocument.Bookmarks.Exists("q" + bkmk) = True
    Dim I
    For I = 1 To 15     ' Loop 15 times.
    Beep                ' Sound a tone.
    Next I
    bkmk = InputBox("Bookmark q" + bkmk + " already exists!" & _
        vbCr & "Enter new number.", "Input Equation Number", bkmk + 1)
Loop
    Selection.TypeText Text:="()"
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="temp"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "SEQ eq", PreserveFormatting:=True
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="q" + bkmk
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Style = ActiveDocument.styles("hid.num")
    Selection.TypeText Text:="q" + bkmk
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Application.Run MacroName:="uf"
    ActiveWindow.View.ShowHiddenText = hidcurrent
End Sub
'==============================
Sub ieqref()
' Insert reference to an equation, based on the equation's bookmark.
' Revised 3/16/01.
    Dim tmcount As Integer
    tmcount = 0
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    bkmk = InputBox("Bookmark", "Input Equation Number", "# only")
Do While (ActiveDocument.Bookmarks.Exists("q" + bkmk) = False And _
        tmcount < 3)
    Dim I
    For I = 1 To 15     ' Loop 15 times.
    Beep                ' Sound a tone.
    Next I
    bkmk = InputBox("Bookmark q" + bkmk + " does not exist!" & _
        vbCr & "Enter correct number.", _
        "Input Equation Number", bkmk + 1)
    tmcount = tmcount + 1
Loop
If (tmcount < 4) Then
    ftype$ = "SEQ eq q" + bkmk
    Selection.TypeText Text:="()"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        ftype$, PreserveFormatting:=True
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.Style = ActiveDocument.styles("h")
    Selection.TypeText Text:="RefTo: q" + bkmk
    Application.DisplayStatusBar = True
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
            .ShowBookmarks = False
        End With
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1
Else: MsgBox "Need to look up the bookmark for the equation." & vbCr _
    & "No equation number was entered."
End If
    ActiveWindow.View.ShowHiddenText = hidcurrent
End Sub
'==============================
Sub ifm()
' Macro ifm first allows the user to change the width of the
' object, then queries the user whether the frame should be formatted
' against the left or right margin, then creates a textbox around the
' selected area, then converts the textbox to a frame, then formats
' the frame against the designated margin.  Revised 3/18/01.
    Application.Run MacroName:="fw"
    fmdir = InputBox("Input position of frame" & _
        vbCr & "Left = 0, Right = 1", _
        "Position of Frame", "1")
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.TypeParagraph
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.TypeText Text:="Figure "
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.CreateTextbox
    Selection.ShapeRange(1).ConvertToFrame
    With Selection.Frames(1)
        .Select
        .TextWrap = True
        .WidthRule = wdFrameAuto
        .HeightRule = wdFrameAuto
    If (fmdir = 1) Then .HorizontalPosition = wdFrameRight
    If (fmdir = 0) Then .HorizontalPosition = wdFrameLeft
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        .VerticalPosition = InchesToPoints(0)
        .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
        .HorizontalDistanceFromText = InchesToPoints(0.13)
        .VerticalDistanceFromText = InchesToPoints(0)
        .LockAnchor = False
    End With
    ActiveWindow.ActivePane.VerticalPercentScrolled = 66
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
    Selection.MoveDown Unit:=wdLine, Count:=1
End Sub
'==============================
Sub ift()
'
' IFramedTable Macro
' Insert frame for a table.
'
'** First, ask which side the frame should go on.
    fmdir = InputBox("Input position of frame" & _
        vbCr & "Left = 0, Right = 1", _
        "Position of Frame", "1")
'** Next, ask for the desired width of the frame.
    tmwd = InputBox("Input desired width of table in inches.", _
        "Format Size of Object", "3")
'** Next insert the textbox.
    ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, 238.05, _
        378.2, 279#, 63#).Select
    Selection.ShapeRange.TextFrame.TextRange.Select
    Selection.Collapse
    Selection.TypeText Text:="Table "
    Selection.TypeParagraph
    Selection.ShapeRange(1).ConvertToFrame
    With Selection.Frames(1)
        .Select
        .TextWrap = True
        .WidthRule = wdFrameExact
        .Width = InchesToPoints(tmwd)
        .HeightRule = wdFrameAtLeast
        .Height = InchesToPoints(0.88)
    If (fmdir = 1) Then .HorizontalPosition = wdFrameRight
    If (fmdir = 0) Then .HorizontalPosition = wdFrameLeft
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionMargin
        .VerticalPosition = InchesToPoints(0)
        .RelativeVerticalPosition = wdRelativeVerticalPositionParagraph
        .HorizontalDistanceFromText = InchesToPoints(0.13)
        .VerticalDistanceFromText = InchesToPoints(0)
        .LockAnchor = False
    End With
    With Selection.Frames(1)
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
        .Borders.Shadow = False
    End With
End Sub
'==============================
Sub ii()
' Insert sequence number field and bookmark.  Revised 3/16/01.
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    ftype$ = InputBox("Input type of sequence, e.g., tables, figures, etc.", _
    "Input Sequence Code", "Code")
    bkmk = InputBox("Input bookmark", "Input Arbitrary Number", "number_only")
Do While ActiveDocument.Bookmarks.Exists(ftype$ + bkmk) = True
    Dim I
    For I = 1 To 15     ' Loop 15 times.
    Beep                ' Sound a tone.
    Next I
    bkmk = InputBox("Bookmark " + ftype$ + bkmk + " already exists!" & _
        vbCr & "Enter new number.", "Input Equation Number", bkmk + 1)
Loop
   ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tm1"
   Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "SEQ " + ftype$, PreserveFormatting:=True
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="tm1"
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=ftype$ + bkmk
    Selection.EscapeKey
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Style = ActiveDocument.styles("hid.num")
    Selection.TypeText Text:=ftype$ + bkmk
    Selection.Font.Reset
    Selection.TypeText Text:=" "
    ActiveWindow.View.ShowHiddenText = hidcurrent
    Application.Run MacroName:="uf"
End Sub
'==============================
Sub iiref2()
' Insert reference to sequence number field and bookmark.
' Revised 3/17/01
    Dim tmcount As Integer
    tmcount = 0
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    ftype$ = InputBox("Input type of sequence, e.g., tables, figures, etc.", _
        "Input Sequence Code", "Code")
    bkmk = InputBox("Input bookmark", "Input Number for Referenced Item", "# only")
Do While (ActiveDocument.Bookmarks.Exists(ftype$ + bkmk) = False And _
        tmcount < 3)
    Dim I
    For I = 1 To 15     ' Loop 15 times.
    Beep                ' Sound a tone.
    Next I
    bkmk = InputBox("Bookmark " + ftype$ + bkmk + " does not exist!" & _
        vbCr & "Enter correct number.", _
        "Input Equation Number", bkmk + 1)
    tmcount = tmcount + 1
Loop
If (tmcount > 2) Then
    MsgBox "Need to look up bookmark."
    ActiveWindow.View.ShowHiddenText = hidcurrent
Else
   ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tm1"
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "SEQ " + ftype$ + " " + ftype$ + bkmk, PreserveFormatting:=True
    Selection.Style = ActiveDocument.styles("h")
    Selection.TypeText Text:="RefTo: " + ftype$ + bkmk
    Selection.Font.Reset
    Selection.TypeText Text:=" "
    ActiveWindow.View.ShowHiddenText = hidcurrent
End If
End Sub
'==============================
Sub iiref_plus_bookmark_id()
'
' iiref_plus_bookmark_id Macro
' Alias for the 'kk' macro.  Inserts cross reference to an item type with a visible bookmark.
'
    Application.Run MacroName:="kk"
End Sub
'==============================
Sub il()
'   Insert list number.  Macro revised 3/17/01.
' 'ftype$' is the code name for this number series.  Set to 'L' unless special purpose.
    ftype$ = "L"
    
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    bkmk = InputBox("Input bookmark", "Input Arbitrary Number", "number_only")
'--------------------------------------------------------------------------
If (Not (bkmk = "x")) Then
    Do While ActiveDocument.Bookmarks.Exists(ftype$ + bkmk) = True
        Dim I
        For I = 1 To 15     ' Loop 15 times.
        Beep                ' Sound a tone.
        Next I
        bkmk = InputBox("Bookmark " + ftype$ + bkmk + " already exists!" & _
            vbCr & "Enter new number.", "Input Equation Number", bkmk + 1)
    Loop
End If
'--------------------------------------------------------------------------
   ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tm1"
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "SEQ " + ftype$, PreserveFormatting:=True
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="tm1"
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:=ftype$ + bkmk
    Selection.EscapeKey
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Style = ActiveDocument.styles("h,hidden")
    Selection.TypeText Text:=ftype$ + bkmk
    Selection.Font.Reset
    Selection.TypeText Text:="."
    Selection.Style = ActiveDocument.styles("L3ini")
    Selection.TypeText Text:=vbTab
    Application.Run MacroName:="uf"
    ActiveWindow.View.ShowHiddenText = hidcurrent
End Sub
'==============================
Sub ilref()
'   Insert reference to list item.  Revised 3/17/01
    Dim tmcount As Integer
    tmcount = 0
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    ftype$ = "L"
    bkmk = InputBox("Input bookmark", "Input Number for Referenced Item", "# only")
Do While (ActiveDocument.Bookmarks.Exists(ftype$ + bkmk) = False And _
        tmcount < 3)
    Dim I
    For I = 1 To 15     ' Loop 15 times.
    Beep                ' Sound a tone.
    Next I
    bkmk = InputBox("Bookmark q" + bkmk + " does not exist!" & _
        vbCr & "Enter correct number.", _
        "Input Equation Number", bkmk + 1)
    tmcount = tmcount + 1
Loop
   ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tm1"
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "SEQ " + ftype$ + " " + ftype$ + bkmk, PreserveFormatting:=True
    Selection.Style = ActiveDocument.styles("h")
    Selection.TypeText Text:="RefTo: " + ftype$ + bkmk
    Selection.Font.Reset
    Selection.TypeText Text:=" "
    ActiveWindow.View.ShowHiddenText = hidcurrent
End Sub
'==============================
Sub iq()
'
' iq Macro
' Insert Mathtype 5 equation
'
    Application.Run MacroName:= _
        "MTCommandsMain.MTInsertEquation.InsertInlineEquation"
End Sub
'==============================
Sub ir()
'
' ir Macro
' Insert row in a table
'
    Selection.InsertRows 1
End Sub
'==========================================================================
Sub ired()
'
' ired Macro
' Macro recorded 4/14/2006 by jmiyamot
'
    Application.DisplayAutoCompleteTips = True
    ActiveDocument.AttachedTemplate.AutoTextEntries("redbrackets").Insert _
        Where:=Selection.Range, RichText:=True
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub
'==========================================================================
Sub itab()
'   itab inserts a table without cell borders.  Ok 3/19/01.
    Nrow = InputBox("Input number of rows", "NUMBER OF ROWS", "2")
    ncol = InputBox("Input number of columns", "NUMBER OF COLUMNS", "2")
    ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=Nrow, _
        NumColumns:=ncol, DefaultTableBehavior:=wdWord9TableBehavior, _
        AutoFitBehavior:=wdAutoFitFixed
    Selection.Tables(1).Select
    Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderLeft).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderRight).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderVertical).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
    Selection.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
    Selection.Tables(1).Rows.AllowBreakAcrossPages = False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    ActiveWindow.View.TableGridlines = True

End Sub
'==============================
Sub itr()
' tm1 Macro
' Insert tab at right margin
'
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(6.5), _
        Alignment:=wdAlignTabRight, Leader:=wdTabLeaderSpaces
    Selection.TypeText Text:=vbTab
End Sub
'==============================
Sub itrr()
'
' itrr Macro
' Insert hidden comment at right margin.
'
'    Application.Run MacroName:="itr"
    RunMac ("itr")
    RunMac ("hh")
'    Application.DisplayAutoCompleteTips = True
'    ActiveDocument.AttachedTemplate.AutoTextEntries("hh").Insert Where:= _
'        Selection.Range, RichText:=True
'    Selection.Style = ActiveDocument.Styles("hid.num,hh")
End Sub
'==============================
Sub jmsig()
'
' jmsig Macro
' Insert gif of JM signature
'
Drive$ = InputBox("Enter drive letter, 'E' or 'D'.", "Drive Letter", "E")
    Selection.InlineShapes.AddPicture FileName:=Drive$ & ":\PHOTOS\Images\JM-Sig.gif", _
         LinkToFile:=False, SaveWithDocument:=True
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.InlineShapes(1).LockAspectRatio = msoTrue
    Selection.InlineShapes(1).Height = 29.5
    Selection.InlineShapes(1).Width = 115.2
End Sub
'=================================
Sub KK()
'
' Insert ref to list item and hyperlink to the bookmark
'
    Dim tmcount As Integer
    tmcount = 0
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    ftype$ = InputBox("Input type of sequence, e.g., tables, figures, etc.", _
        "Input Sequence Code", "Code")
    bkmk = InputBox("Input bookmark", "Input Number for Referenced Item", "# only")
Do While (ActiveDocument.Bookmarks.Exists(ftype$ + bkmk) = False And _
        tmcount < 3)
    Dim I
    For I = 1 To 15     ' Loop 15 times.
    Beep                ' Sound a tone.
    Next I
    bkmk = InputBox("Bookmark " + ftype$ + bkmk + " does not exist!" & _
        vbCr & "Enter correct number.", _
        "Input Equation Number", bkmk + 1)
    tmcount = tmcount + 1
Loop
If (tmcount > 2) Then
    MsgBox "Need to look up bookmark."
    ActiveWindow.View.ShowHiddenText = hidcurrent
Else
   ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tm1"
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "SEQ " + ftype$ + " " + ftype$ + bkmk, PreserveFormatting:=True
    Selection.Style = ActiveDocument.styles("h")
    Selection.TypeText Text:="RefTo: " + ftype$ + bkmk
    Selection.Font.Reset
    Selection.TypeText Text:=" "
    ActiveWindow.View.ShowHiddenText = hidcurrent
End If
    Selection.MoveRight Unit:=wdCell
    Selection.Collapse
    Selection.Paste
'######################
    Selection.SelectCell
    Selection.EscapeKey
    Selection.HomeKey Unit:=wdLine
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="tmstartcell"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.SelectCell
    Selection.EscapeKey
    Selection.EndKey Unit:=wdLine
'    Selection.Extend
'    Selection.GoTo What:=wdGoToBookmark, Name:="tmstartcell"
'    With ActiveDocument.Bookmarks
'        .DefaultSorting = wdSortByName
'        .ShowHidden = False
'    End With
'    Selection.EscapeKey
'    Selection.EndKey Unit:=wdLine
    SelectToBookmark ("tmstartcell")
    LinkToName$ = Selection.Text
    BkMkName = ftype$ + bkmk
    Selection.Delete Unit:=wdCharacter, Count:=1
    
'    Selection.TypeText Text:="####"
'    Selection.TypeText Text:=LinkToName$
' Selection.TypeText Text:="#1#: " + BkMkName + "#2#: " + LinkToName$ + "#3#"
    
    ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:="", _
        SubAddress:=BkMkName, ScreenTip:="", TextToDisplay:= _
        LinkToName$
'######################

End Sub
'==============================
Sub keep()
'   Keep lines together.  Keep with next.  Ok 3/18/01.
    With Selection.ParagraphFormat
        .WidowControl = True
        .KeepWithNext = True
        .KeepTogether = True
    End With
End Sub
'==============================
Sub linenum()
' linenum macro adds line numbers to the document.  Ok 3/19/01.
    With Selection.PageSetup
        With .LineNumbering
            .Active = True
            .StartingNumber = 1
            .CountBy = 1
            .RestartMode = wdRestartPage
            .DistanceFromText = wdAutoPosition
        End With
    End With
End Sub
'==============================
Sub mc()
'   MoveCurr: Move bookmark "curr" to the present cursor position.  Revised 3/19/01.
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="curr"
End Sub
'==============================
Sub mca()
' mca Macro
' The 'mca' macro inserts multiple choice answer paragraphs into a document.
' The 'mcaf' macro corrects the sequence numbering of multiple choice answers.
' Usually the reason the answers have gotten out of sequence is that answers have
' been cut and pasted from one question to another.  The 'mcaf' macro carefully
' avoids a bug in the 'mca' macro in which the hidden answer indicators of
' the form -> get deleted.
' Someday there should be a single macro that does the task for both the
' current (8/16/2005) 'mcaf' and 'mca' macros.
'
    Selection.Style = ActiveDocument.styles("L2")
    With ListGalleries(wdNumberGallery).ListTemplates(5).ListLevels(1)
        .NumberFormat = "%1)"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleLowercaseLetter
        .NumberPosition = InchesToPoints(0.25)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = InchesToPoints(0.5)
        .TabPosition = InchesToPoints(0.5)
        .ResetOnHigher = 0
        .StartAt = 1
        .LinkedStyle = ""
    End With
    ListGalleries(wdNumberGallery).ListTemplates(5).Name = ""
    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
        wdNumberGallery).ListTemplates(5), ContinuePreviousList:=False, ApplyTo:= _
        wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
    With Selection.ParagraphFormat
        .SpaceBefore = 3
        .LineSpacingRule = wdLineSpaceAtLeast
        .LineSpacing = 13.5
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = True
        .PageBreakBefore = False
        .Hyphenation = True
        .FirstLineIndent = InchesToPoints(-0.2)
    End With
    Selection.ParagraphFormat.TabStops.ClearAll
    ActiveDocument.DefaultTabStop = InchesToPoints(0.5)
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(0.2), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
    Selection.ParagraphFormat.TabStops.Add Position:=InchesToPoints(0.4), _
        Alignment:=wdAlignTabLeft, Leader:=wdTabLeaderSpaces
End Sub
'==============================
Sub mcaf()
' mcaf Macro
' fix the format multiple choice answer
' The 'mcaf' macro corrects the sequence numbering of multiple choice answers.
' Usually the reason the answers have gotten out of sequence is that answers have
' been cut and pasted from one question to another.  The 'mcaf' macro carefully
' avoids a bug in the 'mca' macro in which the hidden answer indicators of
' the form -> get deleted.  The 'mca' macro is still needed to insert multiple
' choice answer paragraphs into a document.
' Someday there should be a single macro that does the task for both the
' current (8/16/2005) 'mcaf' and 'mca' macros.
'***************************
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="temp"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Application.DisplayStatusBar = True
    With ActiveWindow
        With .View
            .ShowHiddenText = True
        End With
    End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="tmend"
    End With
    Selection.GoTo What:=wdGoToBookmark, Name:="temp"
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "@#@"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.Font.Reset
    Selection.TypeText Text:="$%$"
    Selection.HomeKey Unit:=wdLine
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="tmbeg"
    End With
    Selection.HomeKey Unit:=wdLine
    Selection.Style = ActiveDocument.styles("L2")
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Style = ActiveDocument.styles("L3ini")
    Selection.MoveDown Unit:=wdLine, Count:=1
    With ListGalleries(wdNumberGallery).ListTemplates(5).ListLevels(1)
        .NumberFormat = "%1)"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleLowercaseLetter
        .NumberPosition = InchesToPoints(0.25)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = InchesToPoints(0.5)
        .TabPosition = InchesToPoints(0.5)
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Name = ""
        End With
        .LinkedStyle = ""
    End With
    ListGalleries(wdNumberGallery).ListTemplates(5).Name = ""
    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
        wdNumberGallery).ListTemplates(5), ContinuePreviousList:=False, ApplyTo:= _
        wdListApplyToWholeList, DefaultListBehavior:=wdWord9ListBehavior
    Selection.GoTo What:=wdGoToBookmark, Name:="temp"
    With ActiveDocument.Bookmarks
       .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "@#@"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.GoTo What:=wdGoToBookmark, Name:="tmbeg"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "@#@"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="tmend"
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "@#@"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "$%$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.MoveDown Unit:=wdLine, Count:=1
    Selection.HomeKey Unit:=wdLine
    With ActiveWindow
        With .View
'            .ShowFieldCodes = False
'            .ShowBookmarks = False
            .ShowHiddenText = False
'            .ShowAll = False
        End With
    End With
End Sub
'==============================
Sub mktabs()
'
' mktabs Macro
' Macro replaces 10 or fewer consequtive blank spaces
' with a single tab.
'
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="dummy"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "          "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "         "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "        "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "       "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "      "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "     "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "    "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "   "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "  "
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = " "
        .Replacement.Text = "^t"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub
'==============================
Sub n()
'   Macro n inserts a new row above the current line.
    Nrow = InputBox("Number of rows to insert above current line", _
"Number of rows?", "1")
    Selection.InsertRowsAbove Nrow
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub
'==============================
Sub nd()
'   Runs the 'NewDoc' macro, which creates a new document based on
'   the JMM.DOT template.
    Application.Run MacroName:="NewDoc"
End Sub
'==============================
Sub NewDoc()
'   Create new document based on the JMM.DOT template.  Ok 3/18/01.
    Documents.Add Template:="\cm\temPLATS\jmm.dot", NewTemplate:=False, _
        DocumentType:=0
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "\cm\templats\jmm.dot"
    End With
End Sub
'==============================
Sub oc()
'  Macro opencurrent opens a file in the currently designated directory.
'  Assign any directory to the dircurr
    dircurr = "E:\nih\curr"
    ChangeFileOpenDirectory dircurr
    SendKeys "%fo"
End Sub
'==============================
Sub par()
'   Opens E:\r\notes\par.doc.  Revised 9/15/02.
    Documents.Open FileName:="E:\r\NOTES\PAR.DOC", Format:=wdOpenFormatAuto
End Sub
'==============================
Sub phidden()
'   Print hidden text.  Revised 3/18/01
    Application.Run MacroName:="uf"
    Range$ = InputBox("Input page numbers to be printed, e.g., p1s1-p3s3", _
        "Print Hidden Text", " ")
    Options.PrintHiddenText = True
    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
        wdPrintDocumentContent, Copies:=1, Pages:=Range$, PageType:= _
        wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False
    Options.PrintHiddenText = False
End Sub
'==============================
Sub pnumcodes()
'   Print bookmark number codes for fields.  Revised 8/7/2004
    Application.Run MacroName:="uf"
    Range$ = InputBox("Input page numbers to be printed, e.g., p1s1-p3s3", _
        "Print 'hid.num' Text", " ")
'# Next we set hidden text to visible and print hidden text to off.
    ActiveWindow.View.ShowHiddenText = True
    Options.PrintHiddenText = False
'# Next we change all 'hid.num' styles to 'vis.num' styles.
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.styles("hid.num")
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.styles("vis.num")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'# Next we print the file.
    Application.PrintOut FileName:="", Range:=wdPrintRangeOfPages, Item:= _
        wdPrintDocumentContent, Copies:=1, Pages:=Range$, PageType:= _
        wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False
'# Next we change all 'vis.num' styles to 'hid.num' style.
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.styles("vis.num")
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Style = ActiveDocument.styles("hid.num")
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'# Next turn off visible hidden text.
   ActiveWindow.View.ShowHiddenText = False
End Sub
'==============================
Sub qed()
'
' QED Macri
' Insert QED box at end of paragraph.
'
    Application.Run MacroName:="itr"
    Selection.TypeText Text:=vbTab
    ActiveDocument.AttachedTemplate.AutoTextEntries("box").Insert Where:= _
        Selection.Range
End Sub
'==============================
Sub remove_review_toolbar()
'
' remove_review_toolbar removes the 'Review' toolbar
' See also the macro 'rrt'
'
    CommandBars("Reviewing").Visible = False
End Sub
'==========================================================================
Sub renum()
'
' renum Macro
' Macro recorded 8/16/2006 by jmiyamot
'
    With ListGalleries(wdNumberGallery).ListTemplates(7).ListLevels(1)
        .ResetOnHigher = 0
        .StartAt = 1
    End With
    ListGalleries(wdNumberGallery).ListTemplates(7).Name = ""
    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
        wdNumberGallery).ListTemplates(7), ContinuePreviousList:=False, ApplyTo:= _
        wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
End Sub
'==========================================================================
Sub RestartNumbering()
'
' Restart number or letter sequence
' Restart numbering
'
    With ListGalleries(wdNumberGallery).ListTemplates(5).ListLevels(1)
        .NumberFormat = "%1)"
        .TrailingCharacter = wdTrailingTab
        .NumberStyle = wdListNumberStyleLowercaseLetter
        .NumberPosition = InchesToPoints(0.25)
        .Alignment = wdListLevelAlignLeft
        .TextPosition = InchesToPoints(0.5)
        .TabPosition = InchesToPoints(0.5)
        .ResetOnHigher = 0
        .StartAt = 1
        With .Font
            .Name = ""
        End With
        .LinkedStyle = ""
    End With
    ListGalleries(wdNumberGallery).ListTemplates(5).Name = ""
    Selection.Range.ListFormat.ApplyListTemplate ListTemplate:=ListGalleries( _
        wdNumberGallery).ListTemplates(5), ContinuePreviousList:=False, ApplyTo:= _
        wdListApplyToWholeList, DefaultListBehavior:=wdWord10ListBehavior
End Sub
'======================================================================================
Sub RestoreStyles()
'
' RestoreStyles Macro
' Restore jmm.dot styles
'
' Set the destination file for the styles.
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
    "FILENAME  \p ", PreserveFormatting:=True
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Fields.Unlink
CurrFile = Selection.Text
Selection.Delete Unit:=wdCharacter, Count:=1

CurrFile = InputBox("Input the drive, path, and name of the file whose styles will be restored", _
     "Restore JMM Styles From JMM.DOT", CurrFile)

' Option to exit from the macro without any action taken.
If (CurrFile = "") Then Exit Sub

    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Normal,n", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="P0", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L2", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="ans", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="blt1", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="ot1", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="ot2", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="blt2", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Default Paragraph Font", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="blue", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="P0ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="c,center", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="cb", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="email", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="cmt", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Heading 1,h1,h1a", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="cntr1", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Heading 2,h2,h2a", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="cntr2", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Heading 3,h3,h3a", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="cntr3", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Comment Text", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="darkblue", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="green", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="DarkRed,dr", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Endnote Text,end", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq1", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq10", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq15", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq20", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq25", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq30", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq40", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eq5", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="eqm", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Footer", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Footnote Text,ft", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="h,hidden", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Header", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Heading 4,h4", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Heading 5", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="hh,hid.num", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="i2", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="i3", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="i4", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L10", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L2ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L10ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L3", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L3ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L4", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L4ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L5", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L5ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="L8", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="mc", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="mc1", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="mc2", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="mcq", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="No List", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="ot3", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="P5", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="P5ini", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Page Number", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Parabnd", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="quote", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="secbnd", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="r", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="red", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="rr", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="sm", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="sp", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="spss", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Style blue + Times New (W1) Pale Blue", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Style green + Times New (W1) Lime", Object:= _
        wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="subp", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="Table Normal", Object:=wdOrganizerObjectStyles
    Application.OrganizerCopy Source:="E:\cm\templats\jmm.dot", Destination:= _
        CurrFile, Name:="vsmall", Object:=wdOrganizerObjectStyles
End Sub
'======================================================================================
Sub RmMarkup()
' Removes the Web Markup toolbar
'
    CommandBars("Reviewing").Visible = False
End Sub
'==============================
Sub rmstyles()
' rmstyles Macro
' Removes the 'h1c', 'h2c' and 'h3c' styles from the document template.
'
    ActiveDocument.styles("h1c").Delete
    ActiveDocument.styles("h2c").Delete
    ActiveDocument.styles("h3c").Delete
End Sub
'====================================================
Sub rn()
' renum Macro
' Restart number or letter sequence (abbreviated)
'
    Application.Run MacroName:="TP.my.RestartNumbering"
End Sub
'==============================
Sub rrt()
'
' rrt removes the 'Review' toolbar
' See also the macro 'remove_review_toolbar'
'
    CommandBars("Reviewing").Visible = False
End Sub
'===============================================================
Public Sub RunMac(sss As String)
' 'RunMac' runs the macro with the input name.
    Application.Run MacroName:=sss
End Sub
'===============================================================
Sub sa()
'
' sa Macro
' Reference to short answer page location
'
    Target = InputBox("Bookmark for Short Answer Location:", _
        "Bookmark", "what?")
    Selection.InsertCrossReference ReferenceType:="Bookmark", ReferenceKind:= _
        wdPageNumber, ReferenceItem:=Target, InsertAsHyperlink:=True, _
        IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" "
End Sub

'===============================================================
Public Sub SelectAllOverlappingParas()
'SelectAllOverlappingParas' function selects all paragraphs that are at least partially highlighted in the current selection.

' All paragraphs touched by the selection are given the bookmark "tmInitialSelectionPlus"
AddBookmark ("tmInitialSelection")
Selection.HomeKey Unit:=wdLine
SelectCurrPara
AddBookmark ("tmInitialSelectionStart")
GoToBook ("tmInitialSelection")
Selection.EndKey Unit:=wdLine
SelectCurrPara
AddBookmark ("tmInitialSelectionLast")
GoToBook ("tmInitialSelectionStart")
Selection.Extend
Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelectionLast"
AddBookmark ("tmInitialSelectionPlus")
Selection.EscapeKey

End Sub    'end "SelectAllOverlappingParas"
'==============================================
Sub SelectColumn()
'   Selects column of table that contains cursor.  Ok 3/19/01.
    Selection.SelectColumn
End Sub
'==============================
Sub SelectRow()
'   Selects row of table that contains cursor.  Ok 3/19/01.
    Selection.SelectRow
End Sub
'==============================
Sub SelectTable()
'   Selects the entire table.  Ok 3/18/01.
    Selection.Tables(1).Select
End Sub
'==============================
Sub shade()
'   Add shading to a paragraph.  Use Ctrl-Q to remove shading.  Ok 3/19/01.
    With Selection.ParagraphFormat
        With .Shading
            .Texture = wdTexture5Percent
            .ForegroundPatternColorIndex = wdAuto
            .BackgroundPatternColorIndex = wdWhite
        End With
    End With
End Sub
'==============================
Sub SplitTable()
'   Splits table above selected row.  Ok 3/18/01.
    Selection.SplitTable
End Sub
'==============================
Sub st()
'   Strikethrough Toggle.  Ok 3/18/01.
    If (Not Selection.Font.StrikeThrough) Then Selection.Style = ActiveDocument.styles("darkred")
    Selection.Font.StrikeThrough = Not Selection.Font.StrikeThrough
End Sub
'==============================
Sub stripfields()
'   Unlink all fields (replace with current value)and
'   delete all hidden text.  This macro is useful when
'   sending documents to other users.  Revised 3/19/01.
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tmcurr"
    Selection.WholeStory
    Selection.Fields.Unlink
    Selection.HomeKey Unit:=wdLine
    hidcurrent = ActiveWindow.View.ShowHiddenText
    ActiveWindow.View.ShowHiddenText = True
    Selection.Find.ClearFormatting
    Selection.Find.Font.Hidden = True
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.View.ShowHiddenText = hidcurrent
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
End Sub
'==============================
Sub Subscript()
' Format subscript character
    With Selection.Font
        .Size = 9
        .superscript = False
        .Subscript = False
        .Position = -3
        .Kerning = 0
    End With
End Sub
'==============================
Sub superscript()
' Format superscript character.  Ok 3/19/01.
    With Selection.Font
        .Size = 9
        .superscript = False
        .Subscript = False
        .Position = 4
        .Kerning = 0
    End With
End Sub
'==============================
Sub togblu()
'
' togblu Macro
' Toggle blue background/white text versus white background/black text
'
    Options.BlueScreen = Not Options.BlueScreen
End Sub
'==============================
Sub TogDrawingTools()
'   Toggle drawing tool bar
    CommandBars("Drawing").Visible = Not CommandBars("Drawing").Visible
End Sub
'==============================
Sub togfields()
'   Togfields toggles the viewing of field codes and hidden text.  Revised 3/16/01.
    ActiveWindow.View.ShowFieldCodes = Not ActiveWindow.View.ShowFieldCodes
    ActiveWindow.View.ShowHiddenText = Not ActiveWindow.View.ShowHiddenText
End Sub
'==============================
Sub toghidden3()
'   Toggle view of hidden text.  Revised 3/16/01.
    ActiveWindow.View.ShowHiddenText = Not ActiveWindow.View.ShowHiddenText
End Sub
'==============================
Sub togpics()
'
' toggle picture place holders
'
    ActiveWindow.View.ShowPicturePlaceHolders = Not ActiveWindow.View.ShowPicturePlaceHolders
End Sub
'==============================
Sub togPicTools()
'   Toggles the picture tool bar.
    CommandBars("Picture").Visible = Not CommandBars("Picture").Visible
End Sub
'==============================
Sub TogRuler()
'   Toggle rule.  1/19/99, JMM.
    ActiveWindow.ActivePane.DisplayRulers = Not ActiveWindow.ActivePane. _
        DisplayRulers
End Sub
'==============================
Sub TogSplit()
' Macro toggles window between a 50/50 split and no split.
Application.Run MacroName:="ts"
End Sub
'=============================================================
Sub togtabs()
'   Toggles tab marks and paragraph marks.  Ok 3/19/01.
    Application.DisplayStatusBar = True
    With ActiveWindow
        With .View
            .ShowTabs = Not .ShowTabs
            .ShowParagraphs = Not .ShowParagraphs
        End With
    End With
End Sub
'=============================================================
Sub togtools()
' 'togtools' Macro
' Toggle the Standard and Formatting toolbars.
'
    CommandBars("Formatting").Visible = Not CommandBars("Formatting").Visible
    CommandBars("Standard").Visible = Not CommandBars("Standard").Visible
End Sub
'=============================================================
Sub ts()
' Macro toggles window between a 50/50 split and no split.
'
   SplitCurr = ActiveWindow.SplitVertical
   If SplitCurr = 0 Then SplitCurr = 50 Else SplitCurr = 0
   ActiveWindow.SplitVertical = SplitCurr
End Sub
'=========================
Sub uf()
'   Macro that updates all fields in the document.  Revised 3/19/01.
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="current"
    Selection.WholeStory
    Selection.Fields.Update
    Selection.GoTo What:=wdGoToBookmark, Name:="current"
End Sub
'==============================
Sub uh()
'   uh Macro
'   Unhides the selected text.
    With Selection.Font
        .Hidden = False
    End With
End Sub
'==============================
Sub unac1()
'   Detach templates for creating an Acrobat Reader file.
'   This macro is appropriate for the configuration of the home computer(?).
    AddIns("E:\cm\templats\PDFMaker.dot").Installed = False
    AddIns("D:\adobe\Acrobt405\Macros\Office2000\PDFMakerA.dot").Installed = _
        False
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "E:\cm\templats\jmm.dot"
    End With
End Sub
'==============================
Sub unjmm()
'   Uninstalls JMM.DOT from the list of installed templates,
'   but retains JMM.DOT at the attached template.  Revised 3/19/01.
    AddIns("E:\cm\templats\JMM.DOT").Installed = False
End Sub
'==============================
Sub unnorm()
'   Detach normal.dot from the current document.  Ok 3/19/01.
    AddIns("E:\NORMAL.DOT").Installed = False
    With ActiveDocument
        .UpdateStylesOnOpen = True
        .AttachedTemplate = "E:\cm\templats\jmm.dot"
    End With
End Sub
'==============================
Sub useful()
'
' useful Macro
' Loads the 'e:\r\notes\useful.doc' file.
'
    ChangeFileOpenDirectory "E:\r\"
    Documents.Open FileName:="useFUL.DOC", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto
End Sub
'==============================

Sub ViewTwo()
' ViewTwo Macro.  Revised 3/16/01.
    ActiveWindow.ActivePane.View.Type = wdPageView
    With ActiveWindow.ActivePane.View.Zoom
        .PageColumns = 2
        .PageRows = 1
    End With
End Sub
'==============================
Sub ViewWholePage()
' ViewWholePage Macro.  Revised 3/16/01.
    With ActiveWindow.ActivePane
        .View.Type = wdPageView
        .View.Zoom.PageFit = wdPageFitFullPage
    End With
End Sub
'==============================
Sub wm()
' wm Macro
' Maximize current window and unsplit the window if it is split into 2 panes.
'
    Application.WindowState = wdWindowStateMaximize
    ActiveWindow.SplitVertical = 100
    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
End Sub
'==============================
Sub zm()
' zm Macro
' Zoom window
'
    zmpct = InputBox("Input Zoom Percent" & _
        vbCr & "E.g., 75 or 100 or 150, etc.", _
        "Zoom Window Size", "100")
    ActiveWindow.ActivePane.View.Zoom.Percentage = zmpct
End Sub
'==============================
********* End of 'My' module in JMM.DOT ************

********* 'R' module in JMM.DOT ************
'******************************************
'*** R Macros below this line ******************
'******************************************
Sub RunLine()
Application.Run MacroName:="rl"
End Sub
'==============================================================
Sub RunSection()
Application.Run MacroName:="rs"
End Sub
'==============================================================
Sub Insertsection()
Application.Run MacroName:="isec"
End Sub
'==============================================================
Sub InsertFrame()
Application.Run MacroName:="ifm"
End Sub
'=============================================
Sub RL()
' Current 3/2/2006.
' Macro RL copies the current line to the clipboard, transfers control to R, and
' runs the clipboard contents in R.
' First extend the selection to all paragraphs that are touched by the selection.
' All paragraphs touched by the selection are given the bookmark "tmInitialSelectionPlus"
AddBookmark ("tmInitialSelection")
Selection.HomeKey Unit:=wdLine
'-------
' The following code is equivalent to the 'SelectCurrPara' macro.
' 'SelectCurrPara' is not used here because it may not be available
' to other (non-JMM) users.
    Selection.EscapeKey
    Selection.Find.ClearFormatting
    Selection.Collapse Direction:=wdCollapseStart
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = False
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.StartOf Unit:=wdParagraph
    Selection.EndOf Unit:=wdParagraph, Extend:=wdExtend
' ---- End of 'SelectCurrPara' macro code ---
AddBookmark ("tmInitialSelectionStart")
GoToBook ("tmInitialSelection")
Selection.EndKey Unit:=wdLine
' The code for 'SelectCurrPara' is inserted a second time here.
    Selection.EscapeKey
    Selection.Find.ClearFormatting
    Selection.Collapse Direction:=wdCollapseStart
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = False
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.StartOf Unit:=wdParagraph
    Selection.EndOf Unit:=wdParagraph, Extend:=wdExtend
' ---- End of 'SelectCurrPara' macro code ---
AddBookmark ("tmInitialSelectionLast")
GoToBook ("tmInitialSelectionStart")
Selection.Extend
Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelectionLast"
AddBookmark ("tmInitialSelectionPlus")
Selection.Copy
Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelection"
SendKeys "%w1+{insert}{enter}^{F6}"
AppActivate "RGui", wait = True
End Sub
'=============================================
Sub isec()
' Current 01/24/03.
' Insert Section Markers in R Code
'
    Selection.Style = ActiveDocument.styles("secbnd")
    Selection.TypeText Text:="#Section: -------------------------------------"
    Selection.TypeParagraph
    Selection.Style = ActiveDocument.styles("r")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Style = ActiveDocument.styles("secbnd")
    Selection.TypeText Text:="#EndSection: ----------------------------------"
    Selection.MoveUp Unit:=wdLine, Count:=2
End Sub
'------------------------------------------
Sub rp()
' Current 01/24/03.
' rc macro runs the R code between #First: and #Last:
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="tmcurr"
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "#First:"
        .Forward = False
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute
'    If Selection.Find.Found = False Then Stop '"#First" not found.'
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="afirst"
    End With
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "#Last:"
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
'    If Selection.Find.Found = False Then Stop '"#Last" not found.'
    Selection.Find.Execute
    Selection.EndKey Unit:=wdLine
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="afirst"
    Selection.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    ActiveWindow.ActivePane.SmallScroll Down:=-3
SendKeys "%w1+{insert}{enter}^{F6}"
AppActivate "RGui", wait = True
End Sub
Sub rsp()
' Current 12/20/04.
' rsp macro runs the R code between '#Subp.ini' and '#Subp.end'
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="tmcurr"
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "#Subp.ini"
        .Forward = False
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="afirst"
    End With
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "#Subp.end"
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdLine
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="afirst"
    Selection.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    ActiveWindow.ActivePane.SmallScroll Down:=-3
SendKeys "%w1+{insert}{enter}^{F6}"
AppActivate "RGui", wait = True
End Sub
'--------------------
Sub ip()
' Current 01/24/03.
' Insert markers for "paragraph" of R code
'
    Selection.Style = ActiveDocument.styles("parabnd")
    Selection.TypeText Text:="#First: ----------------"
    Selection.TypeParagraph
    Selection.Style = ActiveDocument.styles("r")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Style = ActiveDocument.styles("parabnd")
    Selection.TypeText Text:="#Last:  ----------------"
    Selection.MoveUp Unit:=wdLine, Count:=2
End Sub
'--------------------
Sub isubp()
' Current 01/24/03.
' Insert markers for "sub paragraph" of R code
'
    Selection.Style = ActiveDocument.styles("subp")
    Selection.TypeText Text:="#Subp.ini  ---------------"
    Selection.TypeParagraph
    Selection.Style = ActiveDocument.styles("r")
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.Style = ActiveDocument.styles("subp")
    Selection.TypeText Text:="#Subp.end  ---------------"
    Selection.MoveUp Unit:=wdLine, Count:=2
End Sub

'---------------------
Sub rs()
' Current 01/24/03.
' rs macro runs the R code between #Section: and #EndSection:
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tmcurr"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "#Section:"
        .Forward = False
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="aSection"
    End With
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    With Selection.Find
        .Text = "#EndSection:"
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdLine
    Selection.Extend
    Selection.GoTo What:=wdGoToBookmark, Name:="aSection"
    Selection.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    ActiveWindow.ActivePane.SmallScroll Down:=-3
SendKeys "%w1+{insert}{enter}^{F6}"
AppActivate "RGui", wait = True
End Sub
Sub mp()
' Current 11/18/05
' Find matching parentheses.
' The initial section declares variables, sets them to initial values,
' and places the OpenStart bookmark at the current cursor location.
SDir = InputBox("Direction of search:  1 = Down (default),  2 = Up" + _
    ", Anything else = Quit", "Input Search Direction", "1")

Dim OpnCount As Integer, ClsCount As Integer, Response As Integer
Dim MaxAllowed As Integer, CheckNum As Integer, TestCont As Integer
Dim Opn As String, Cls As String
OpnCount = 0
ClsCount = 0
CheckNum = 0
MaxAllowed = 241
TestCont = MaxAllowed - 1
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="OpenStart"
' Start of initial Do While loop.
' This loop finds the first occurrence of a demarcator, determines its
' type, and sets the OpenStart bookmark at the location of this demarcator.
' This first part handles the case where the search is Down.
If SDir = 1 Then
Do While (OpnCount = 0) And (CheckNum < MaxAllowed)
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'** This section determines which type of paren we are searching for
'** and initializes the count.
    If Selection.Characters(1) = "(" Then
        OpnCount = OpnCount + 1
        Opn = "("
        Cls = ")"
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
        Name:="OpenStart"
    End If
    If Selection.Characters(1) = "[" Then
        OpnCount = OpnCount + 1
        Opn = "["
        Cls = "]"
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
        Name:="OpenStart"
    End If
    If Selection.Characters(1) = "{" Then
        OpnCount = OpnCount + 1
        Opn = "{"
        Cls = "}"
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
        Name:="OpenStart"
    End If
'** End of section that determines the character to be searched for.
    CheckNum = CheckNum + 1
    Selection.MoveRight Unit:=wdCharacter, Count:=1
' The next if-then-else gives the user an opportunity to exit the macro if
' no demarcators have yet been found.
    If CheckNum = TestCont Then
        Response = MsgBox(Str(CheckNum) + " characters have been checked." _
            & vbCr & "Do you want to continue?", _
            vbYesNo + vbDefaultButton1)
        If (Response = 6) Then
            CheckNum = 0
        Else
            Selection.GoTo What:=wdGoToBookmark, Name:="OpenStart"
            Selection.MoveLeft Unit:=wdCharacter, Count:=1
        End If
    End If
Loop
' End of initial Do While loop for the search in the Down direction.
End If
' End of If SDir = 1
'*****************
If SDir = 2 Then
Do While (OpnCount = 0) And (CheckNum < MaxAllowed)
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
'** This section determines which type of paren we are searching for
'** and initializes the count.
    If Selection.Characters(1) = ")" Then
        OpnCount = OpnCount + 1
        Opn = ")"
        Cls = "("
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
        Name:="OpenStart"
    End If
    If Selection.Characters(1) = "]" Then
        OpnCount = OpnCount + 1
        Opn = "]"
        Cls = "["
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
        Name:="OpenStart"
    End If
    If Selection.Characters(1) = "}" Then
        OpnCount = OpnCount + 1
        Opn = "}"
        Cls = "{"
        ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
        Name:="OpenStart"
    End If
'** End of section that determines the character to be searched for.
    CheckNum = CheckNum + 1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
' The next if-then-else gives the user an opportunity to exit the macro if
' no demarcators have yet been found.
    If CheckNum = TestCont Then
        Response = MsgBox(Str(CheckNum) + " characters have been checked." _
            & vbCr & "Do you want to continue?", _
            vbYesNo + vbDefaultButton1)
        If (Response = 6) Then
            CheckNum = 0
        Else
            Selection.GoTo What:=wdGoToBookmark, Name:="OpenStart"
            Selection.MoveLeft Unit:=wdCharacter, Count:=1
        End If
    End If
Loop
' End of initial Do While loop for the search in the Up direction.
End If
' End of If SDir = 2
'*****************
' By this point, the macro has determined
' the type of demarcator, or none has been found and the macro is terminated.

' The next Do Until loop searches in the Down direction for a matching
' demarcator to the one that was initially found.
If SDir = 1 Then
Do Until (OpnCount <= ClsCount) Or (CheckNum >= MaxAllowed)
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If Selection.Characters(1) = Opn Then OpnCount = OpnCount + 1
        If Selection.Characters(1) = Cls Then ClsCount = ClsCount + 1
        CheckNum = CheckNum + 1
        If (OpnCount = ClsCount) Then _
            ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
                Name:="CloseEnd"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    If OpnCount = ClsCount Then
        Selection.Extend
        Selection.GoTo What:=wdGoToBookmark, Name:="OpenStart"
    End If
' The next if-then-else gives the user an opportunity to exit the macro if
' no demarcators have yet been found.
    If CheckNum = TestCont Then
        Response = MsgBox(Str(CheckNum) + " characters have been checked." _
            & vbCr & "Do you want to continue?", _
            vbYesNo + vbDefaultButton1)
        If (Response = 6) Then
            CheckNum = 0
        Else
            Selection.GoTo What:=wdGoToBookmark, Name:="OpenStart"
            Selection.MoveLeft Unit:=wdCharacter, Count:=2
        End If
    End If
Loop
' This is the end of the Do Until loop.  At this point, either the matching
' demarcator has been found, or the user has chosen to terminate the macro.
End If
' End of If Sdir = 1
'*****************************************
' The next Do Until loop searches in the Up direction for a matching
' demarcator to the one that was initially found.
If SDir = 2 Then
Do Until (OpnCount <= ClsCount) Or (CheckNum >= MaxAllowed)
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If Selection.Characters(1) = Opn Then OpnCount = OpnCount + 1
        If Selection.Characters(1) = Cls Then ClsCount = ClsCount + 1
        CheckNum = CheckNum + 1
        If (OpnCount = ClsCount) Then _
            ActiveDocument.Bookmarks.Add Range:=Selection.Range, _
                Name:="CloseEnd"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    If OpnCount = ClsCount Then
        Selection.Extend
        Selection.GoTo What:=wdGoToBookmark, Name:="OpenStart"
    End If
' The next if-then-else gives the user an opportunity to exit the macro if
' no demarcators have yet been found.
    If CheckNum = TestCont Then
        Response = MsgBox(Str(CheckNum) + " characters have been checked." _
            & vbCr & "Do you want to continue?", _
            vbYesNo + vbDefaultButton1)
        If (Response = 6) Then
            CheckNum = 0
        Else
            Selection.GoTo What:=wdGoToBookmark, Name:="OpenStart"
            Selection.MoveLeft Unit:=wdCharacter, Count:=2
        End If
    End If
Loop
' This is the end of the Do Until loop.  At this point, either the matching
' demarcator has been found, or the user has chosen to terminate the macro.
End If
' End of If Sdir = 2
'*****************************************
End Sub
' *****************************************************************
Sub cmt()
' Current 3/25/2006.
' Comment out the highlighted section of text.
'
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="temp1"

Selection.EscapeKey
Selection.HomeKey Unit:=wdLine
Selection.MoveLeft Unit:=wdCharacter, Count:=1
With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, Name:="LeftOfCommentStart"
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With

Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="temp1"
Selection.EscapeKey
Selection.EndKey Unit:=wdLine
With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, Name:="EndofComment"
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With

Selection.Extend
Selection.GoTo What:=wdGoToBookmark, Name:="LeftOfCommentStart"

If Selection.Type <> wdSelectionIP Then
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = "^p# "
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End If

Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="temp1"
Selection.Style = ActiveDocument.styles("cmt")
End Sub
'================================================================
Sub uncmt()
' Current 3/25/2006.
' Remove commenting out of highlighted section of text.
'
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="temp1"

Selection.EscapeKey
Selection.HomeKey Unit:=wdLine
Selection.MoveLeft Unit:=wdCharacter, Count:=1
With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, Name:="LeftOfCommentStart"
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With

Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="temp1"
Selection.EscapeKey
Selection.EndKey Unit:=wdLine
With ActiveDocument.Bookmarks
    .Add Range:=Selection.Range, Name:="EndofComment"
    .DefaultSorting = wdSortByName
    .ShowHidden = False
End With

Selection.Extend
Selection.GoTo What:=wdGoToBookmark, Name:="LeftOfCommentStart"
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="CommentText"

If Selection.Type <> wdSelectionIP Then
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p# "
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Selection.EscapeKey
    Selection.GoTo What:=wdGoToBookmark, Name:="CommentText"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p#"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End If

Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="temp1"
Selection.Style = ActiveDocument.styles("r")
End Sub
'===========================================================
Sub rc()
' Current 01/24/03.
' Run R code in a table cell (RunCell).
'
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tmcurr"
    Selection.SelectCell
    Selection.Copy
    Selection.EndKey Unit:=wdStory
    Application.Run MacroName:="isec"
    Application.Run MacroName:="MathTypeCommands.UIWrappers.EditPaste"
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
        NestedTables:=True
    Selection.HomeKey Unit:=wdLine
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "#Section"
        .Replacement.Text = ""
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Extend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "#EndSection"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Cut
    Selection.GoTo What:=wdGoToBookmark, Name:="tmcurr"
    ActiveWindow.ActivePane.SmallScroll Down:=-3
SendKeys "%w1+{insert}{enter}^{F6}"
AppActivate "RGui", wait = True
End Sub
Sub rcell()
' Current 01/24/03.
' Macro recorded January 17, 2002 by John M. Miyamoto
'
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="initial"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.SelectCell
    Selection.Copy
    Selection.EndKey Unit:=wdStory
    Application.Run MacroName:="MathTypeCommands.UIWrappers.EditPaste"
    Selection.MoveUp Unit:=wdLine, Count:=2
    Selection.SelectCell
    Selection.Rows.ConvertToText Separator:=wdSeparateByParagraphs, _
        NestedTables:=True
    Selection.Cut
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "initial"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.GoTo What:=wdGoToBookmark, Name:="initial"
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
End Sub
Sub ass()
' Current 01/24/03.
' The ass macro converts " _ " to " <- ", but does not convert "_".
'
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="PosNow"
        .DefaultSorting = wdSortByName
    End With
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .Text = " _ "
        .Replacement.Text = " <- "
        .Forward = True
        .Wrap = wdFindContinue
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.GoTo What:=wdGoToBookmark, Name:="PosNow"
    ActiveDocument.Bookmarks("PosNow").Delete
End Sub
'****** R Macros Above This Line **********************
'******************************************************
Sub funcode()
'
' funcode Macro
' temp funcode function
'
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="start_funcode"
    End With
    Selection.HomeKey Unit:=wdLine
    Selection.Extend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<-"
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=3
    Selection.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="start_funcode"
    Selection.TypeText Text:="{"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:="} #end def of '"
    Application.Run MacroName:="MathTypeCommands.UIWrappers.EditPaste"
    Selection.TypeText Text:="' function"
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.MoveUp Unit:=wdLine, Count:=1
End Sub


'------------------------------------------------------
Sub ifcode()
'
' ifcode Macro
' Rcode: 'if' macro
'
    Selection.TypeText Text:="{"
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="startif"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ")"
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Extend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "if"
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="startif"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:=vbTab & "} #end '"
    Selection.Paste
    Selection.TypeText Text:="'"
    Selection.HomeKey Unit:=wdLine
'    Selection.MoveUp Unit:=wdLine, Count:=2
End Sub
Sub forcode()
'
' forcode Macro
' Rcode: 'for' macro
'
    Selection.TypeText Text:="{"
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="startfor"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ")"
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Extend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "for"
        .Forward = False
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    Selection.Copy
    Selection.GoTo What:=wdGoToBookmark, Name:="startfor"
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeText Text:=vbTab & "} #end '"
    Application.Run MacroName:="MathTypeCommands.UIWrappers.EditPaste"
    Selection.TypeText Text:="'"
    Selection.HomeKey Unit:=wdLine
'    Selection.MoveUp Unit:=wdLine, Count:=2
End Sub
Sub rb()
' rb Macro
' This macro asks the user for the name of a bookmark.  It then copies
' the bookmark text to the clipboard, transfers control to R, and
' runs the clipboard text in R.  This macro still needs some work,
' but it is basically correct.
'
    With ActiveDocument.Bookmarks
        .Add Range:=Selection.Range, Name:="currentposition"
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
'
    bkmk = InputBox("Input bookmark of code to be run in R", "Input Bookmark", "Bookmark")
'
    Selection.GoTo What:=wdGoToBookmark, Name:=bkmk
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
'
    Selection.Copy
'
    Selection.GoTo What:=wdGoToBookmark, Name:="currentposition"
    With ActiveDocument.Bookmarks
        .DefaultSorting = wdSortByName
        .ShowHidden = False
    End With
'

'    ActiveWindow.ActivePane.SmallScroll Down:=-3
    SendKeys "%w1+{insert}{enter}^{F6}"
    AppActivate "RGui", wait = True
'
End Sub
'============================================================================
Sub nl()
'
' nl Macro
' Create a new line in a vector of strings when programming R.
'
Dim PadString As String
PadString = ""
Selection.HomeKey Unit:=wdLine
    Do
        Selection.EscapeKey
        Selection.Collapse Direction:=wdCollapseEnd
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If (Selection.Text = " " Or Selection.Text = Chr(9)) Then PadString = PadString & Selection.Text
    Loop Until (Selection.Text <> " " And Selection.Text <> Chr(9))
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:=Chr(34) & Chr(44) & Chr(13) & PadString & Chr(34)
End Sub
'===============================================================
Sub nll()
'
' nll Macro
' Create a split line in a string when programming R to create documentation.
'
Dim PadString As String
PadString = ""
Selection.EscapeKey
Selection.TypeParagraph
Selection.EscapeKey
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=Chr(34) & Chr(44) & Chr(13) & PadString & Chr(34)

Selection.HomeKey Unit:=wdLine
    Do
        Selection.EscapeKey
        Selection.Collapse Direction:=wdCollapseEnd
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If (Selection.Text = " " Or Selection.Text = Chr(9)) Then PadString = PadString & Selection.Text
    Loop Until (Selection.Text <> " " And Selection.Text <> Chr(9))
Selection.EndKey Unit:=wdLine
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveLeft Unit:=wdCharacter, Count:=4

End Sub
'=================================================================
Sub varlist()
'
' varlist Macro
' create variable list
'
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tmInitialSelection"

Do

Selection.Find.ClearFormatting
With Selection.Find
    .Text = "["
    .Replacement.Text = ""
    .Forward = True     'Direction choices:  True, False
    .Wrap = wdFindStop      'Wrap choices: wdFindContinue, wdFindAsk, wdFindStop
    .MatchCase = False
    .MatchWholeWord = False
    .Format = False
End With
Selection.Find.Execute
BrackNotFound = Not Selection.Find.Found

If Not BrackNotFound Then
    Selection.Extend
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "]"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .MatchCase = False
        .MatchWholeWord = False
        .Format = False
    End With
    Selection.Find.Execute
    
    If Selection.Find.Found Then
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelection"
    End If  'end of 'If Selection.Find.Found
    
End If  'end of 'If Not BrackNotFound'

Loop Until BrackNotFound

Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelection"
'-------------------------
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = False
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = """ "
        .Replacement.Text = ""","
        .Forward = False
        .Wrap = False
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Application.Run MacroName:="blanktotab"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = False
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelection"

End Sub
'======================================
Sub makedata()
'
' scan.data Macro
' Convert Word table to input for R 'scan' function
'
    Selection.Tables(1).Select
    Selection.Copy
    Application.Run MacroName:="nd"
    Selection.WholeStory
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.TypeParagraph
    Selection.HomeKey Unit:=wdStory
    Selection.Paste
    Selection.MoveUp Unit:=wdLine, Count:=1
    Selection.Tables(1).Select
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ".tab."
        .Forward = True
        .Wrap = False
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
        True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ".tab."
        .Forward = True
        .Wrap = False
        .Format = False
    End With
    ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tmdata"
    Selection.HomeKey Unit:=wdLine
    Selection.TypeText Text:=""""
    Selection.GoTo What:=wdGoToBookmark, Name:="tmdata"
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "^t"
        .Replacement.Text = ""","""
        .Forward = True
        .Wrap = False
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "^p"
        .Replacement.Text = """^p"""
        .Forward = True
        .Wrap = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.GoTo What:=wdGoToBookmark, Name:="tmdata"
    Selection.EndKey Unit:=wdLine
    Selection.TypeBackspace
    ActiveDocument.SaveAs FileName:="e:\tm\tmdata.txt", FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=1252, InsertLineBreaks:=False, AllowSubstitutions:=False _
        , LineEnding:=wdCRLF
    ActiveDocument.Close
    Documents.Open FileName:="e:\tm\tmdata.txt", ConfirmConversions:=False, ReadOnly _
        :=False, AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate _
        :="", Revert:=False, WritePasswordDocument:="", WritePasswordTemplate:="" _
        , Format:=wdOpenFormatAuto, XMLTransform:="", Encoding:=1252
    Selection.EndKey Unit:=wdStory
    Selection.MoveUp Unit:=wdLine, Count:=2, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
    ActiveDocument.Save
    ActiveDocument.Close
End Sub
'====================================================================================
Public Sub iparen()
' 'iparen' encloses all paragraphs that are at least partially highlighted
' in the current selection within paragraphs.  (Useful when writing R code.)
Application.Run MacroName:="SelectAllOverlappingParas"
Selection.EscapeKey
Selection.HomeKey Unit:=wdLine
Selection.TypeText Text:="("
Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelectionPlus"
Selection.EscapeKey
Selection.EndKey Unit:=wdLine
Selection.TypeText Text:=")"
Selection.GoTo What:=wdGoToBookmark, Name:="tmInitialSelection"
End Sub   'end 'paren' macro
'======================================================================================
Public Sub iparen2()
'  'iparen2' encloses all paragraphs that are at least partially highlighted
' in the current selection within paragraphs.  (Useful when writing R code.)
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="tmCurrentSelection"
Selection.EscapeKey
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="("
Selection.EscapeKey
Selection.GoTo What:=wdGoToBookmark, Name:="tmCurrentSelection"
Selection.EscapeKey
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:=")"
Selection.GoTo What:=wdGoToBookmark, Name:="tmCurrentSelection"
End Sub   'end 'paren' macro
'======================================================================================

********* End of 'R' module in JMM.DOT ************





	Date =  October 16, 1997,     File =  G:\scratch.doc		69