Selection.Font.Name = "Bach"
End Sub
Sub Bach_up3down()
    Selection.Font.Name = "Bach stem-up 3rd lower"
End Sub
Sub Bach_up2lower()
    Selection.Font.Name = "Bach stem-up 2nd lower"
End Sub
Sub Bach_restore()
    Selection.Font.Name = "Bach"
End Sub
Sub Bach_up2up()
    Selection.Font.Name = "Bach stem-up 2nd higher"
End Sub
Sub Bach_up3up()
    Selection.Font.Name = "Bach stem-up 3rd higher"
End Sub
Sub Bach_down3lower()
    Selection.Font.Name = "Bach stem-down 3l"
End Sub
Sub Bach_down2lower()
    Selection.Font.Name = "Bach stem-down 2l"
End Sub
Sub Bach_down()
    Selection.Font.Name = "Bach stem-down"
End Sub
Sub Bach_down2higher()
    Selection.Font.Name = "Bach stem-down 2h"
End Sub
Sub Bach_down3higher()
    Selection.Font.Name = "Bach stem-down 3h"
End Sub
Sub Bach_symbol_editor()
'
' Bach_symbol_editor Macro by Yo Tomita (c) 2001
'
Dim original_font$
Dim Mc$
Dim status
Dim too_long
' The aim of this macro is to reduce the amount of time taken to
' input a series of musical symbols to construct musical symbols.
' With this macro, you can now type a series of keyboard accessible
' symbols in a pop-up window. You will see the converted music
' symbols pasted into the document.
'
' Please read BACHCONV.DOC for the conversion table, and the way
' you customise the conversion.
'*****************************************************************
'********   Initializing variables and Checking varidity  ********

If WordBasic.SelInfo(27) Then WordBasic.MsgBox "Command not available in a macro window": GoTo Finish
original_font$ = WordBasic.[Font$]()

Starting:
WordBasic.BeginDialog 364, 76, "Bach: Music Symbol Converter"   '(c) Y.Tomita 1997
    WordBasic.Text 10, 6, 228, 13, "Type the string for conversion", "Text1"    'Instruction
    WordBasic.TextBox 10, 25, 288, 18, "InputStr"
    WordBasic.OKButton 10, 49, 88, 21   'Convert the string and insert it
    WordBasic.CancelButton 108, 49, 88, 21  'Cancel the operation
    WordBasic.PushButton 264, 49, 88, 21, "Help", "Help"    'Call Help Document
WordBasic.EndDialog
Dim Dlg As Object: Set Dlg = WordBasic.CurValues.UserDialog
Dlg.InputStr = Mc$
On Error GoTo -1: On Error GoTo Finish
'Dialog Dlg
status = WordBasic.Dialog.UserDialog(Dlg)
'On Error Goto Finish
Mc$ = Dlg.InputStr
too_long = Len(Dlg.InputStr)

If too_long = 0 And status < 0 Then
WordBasic.MsgBox "Input string was nil!", "Bach: Music Symbol Converter", 0: GoTo Starting
ElseIf status = 0 Then
GoTo Finish
ElseIf status = 1 Then
WordBasic.MsgBox "See BACHCONV.DOC for the conversion table, and the way you customise the conversion.", "Bach: Music Symbol Converter Help", 0: GoTo Starting
End If

Go_on:

' ****************** Conversion routine ****************************
FNct Mc$, "~/~", ChrW$(235)
FNct Mc$, "~~", "~" + ChrW$(252)
FNct Mc$, "tr", ChrW$(255) + ChrW$(251)
FNct Mc$, "lr", ChrW$(174) + ChrW$(251)
FNct Mc$, "Z", ChrW$(186)
FNct Mc$, "~4~", "~~" + ChrW$(61617) + ChrW$(252)
FNct Mc$, "~8~", "~~" + ChrW$(196) + ChrW$(252)
FNct Mc$, "C|", ChrW$(162)
FNct Mc$, "C", ChrW$(161)
FNct Mc$, "(|)", ChrW$(164)
FNct Mc$, "2/2", ChrW$(178) + ChrW$(189)
FNct Mc$, "2/4", ChrW$(178) + ChrW$(188)
FNct Mc$, "3/2", ChrW$(179) + ChrW$(189)
FNct Mc$, "3/4", ChrW$(179) + ChrW$(188)
FNct Mc$, "3/8", ChrW$(179) + ChrW$(190)
FNct Mc$, "3/16", ChrW$(179) + ChrW$(61655)
FNct Mc$, "4/2", ChrW$(166) + ChrW$(189)
FNct Mc$, "4/4", ChrW$(166) + ChrW$(188)
FNct Mc$, "4/8", ChrW$(166) + ChrW$(190)
FNct Mc$, "4/16", ChrW$(166) + ChrW$(61655)
FNct Mc$, "6/4", ChrW$(254) + ChrW$(188)
FNct Mc$, "6/8", ChrW$(254) + ChrW$(190)
FNct Mc$, "6/16", ChrW$(254) + ChrW$(61655)
FNct Mc$, "9/8", ChrW$(221) + ChrW$(190)
FNct Mc$, "9/16", ChrW$(221) + ChrW$(61655)
FNct Mc$, "12/8", ChrW$(185) + ChrW$(190)
FNct Mc$, "12/16", ChrW$(185) + ChrW$(61655)
FNct Mc$, "g-clef", ChrW$(165)
FNct Mc$, "c-clef", ChrW$(170)
FNct Mc$, "f-clef", ChrW$(61608)
FNct Mc$, "5^", ChrW$(222) + "5"
FNct Mc$, "N^", ChrW$(222) + "N"
FNct Mc$, "4^", ChrW$(222) + "F"
FNct Mc$, "3^", ChrW$(222) + "H"
FNct Mc$, "2^", ChrW$(222) + "W"
FNct Mc$, "1^", ChrW$(222) + "O"
FNct Mc$, "------", ChrW$(214) + " - - - - " + ChrW$(181) + " "
FNct Mc$, "----", ChrW$(214) + " - - " + ChrW$(181) + " "
FNct Mc$, "---", ChrW$(214) + " - " + ChrW$(181) + " "
FNct Mc$, "======", ChrW$(61622) + " = = = = " + ChrW$(187) + " "
FNct Mc$, "====_==", ChrW$(61622) + " = = =" + ChrW$(169) + "= " + ChrW$(187) + " "
FNct Mc$, "-====-", ChrW$(214) + " " + ChrW$(233) + "= = " + ChrW$(234) + " " + ChrW$(181) + " "
FNct Mc$, "-====", ChrW$(214) + " " + ChrW$(233) + " = = " + ChrW$(187) + " "
FNct Mc$, "====", ChrW$(61622) + " = = " + ChrW$(187) + " "
FNct Mc$, "===-=", ChrW$(61622) + " = " + ChrW$(234) + " - " + ChrW$(187) + " "
FNct Mc$, "===-", ChrW$(61622) + " = " + ChrW$(234) + " " + ChrW$(181) + " "
FNct Mc$, "-=-=", ChrW$(214) + " " + ChrW$(187) + " " + ChrW$(214) + " " + ChrW$(187) + " "
FNct Mc$, "==-.=-", ChrW$(61622) + " " + ChrW$(234) + " " + ChrW$(181) + ". " + ChrW$(61622) + " " + ChrW$(181) + " "
FNct Mc$, "-==--", ChrW$(214) + " " + ChrW$(233) + " " + ChrW$(234) + " - " + ChrW$(181) + " "
FNct Mc$, "==--", ChrW$(61622) + " " + ChrW$(234) + " - " + ChrW$(181) + " "
FNct Mc$, "-==-", ChrW$(214) + " " + ChrW$(233) + " " + ChrW$(234) + " " + ChrW$(181) + " "
FNct Mc$, "==-", ChrW$(61622) + " " + ChrW$(234) + " " + ChrW$(181) + " "
FNct Mc$, "--==", ChrW$(214) + " - " + ChrW$(233) + " " + ChrW$(187) + " "
FNct Mc$, "-==", ChrW$(214) + " " + ChrW$(233) + " " + ChrW$(187) + " "
FNct Mc$, "-.===", ChrW$(214) + "." + ChrW$(233) + " = " + ChrW$(187) + " "
FNct Mc$, "-.==", ChrW$(214) + ".= " + ChrW$(187) + " "
FNct Mc$, "-.=-.=", ChrW$(214) + "." + ChrW$(187) + " " + ChrW$(214) + "." + ChrW$(187) + " "
FNct Mc$, "-.=-", ChrW$(214) + "." + ChrW$(234) + " " + ChrW$(181) + " "
FNct Mc$, "=-.", ChrW$(61622) + " " + ChrW$(181) + "."
FNct Mc$, "=-=", ChrW$(61622) + " - " + ChrW$(187) + " "
FNct Mc$, "--", ChrW$(214) + " " + ChrW$(181) + " "
FNct Mc$, "-.-.", ChrW$(214) + "." + ChrW$(181) + ". "
FNct Mc$, "****==", ChrW$(231) + " " + ChrW$(232) + " " + ChrW$(232) + " " + ChrW$(238) + " = " + ChrW$(187) + " "
FNct Mc$, "=****=", ChrW$(61622) + " " + ChrW$(237) + " " + ChrW$(232) + " " + ChrW$(232) + " " + ChrW$(238) + " " + ChrW$(187) + " "
FNct Mc$, "===**", ChrW$(61622) + " = = " + ChrW$(237) + " " + ChrW$(236) + " "
FNct Mc$, "==**=", ChrW$(61622) + " = " + ChrW$(237) + " " + ChrW$(238) + " " + ChrW$(187) + " "
FNct Mc$, "=**==", ChrW$(61622) + " " + ChrW$(237) + " " + ChrW$(238) + " = " + ChrW$(187) + " "
FNct Mc$, "=**-", ChrW$(61622) + " " + ChrW$(237) + " " + ChrW$(241) + " " + ChrW$(181) + " "
FNct Mc$, "-**=", ChrW$(214) + " " + ChrW$(239) + " " + ChrW$(238) + " " + ChrW$(187) + " "
FNct Mc$, "-.***", ChrW$(214) + "." + ChrW$(239) + " " + ChrW$(232) + " " + ChrW$(236) + " "
FNct Mc$, "-.**", ChrW$(214) + "." + ChrW$(239) + " " + ChrW$(236) + " "
FNct Mc$, "=**", ChrW$(61622) + " " + ChrW$(237) + " " + ChrW$(236) + " "
FNct Mc$, "**=-", ChrW$(231) + " " + ChrW$(238) + " " + ChrW$(234) + " " + ChrW$(181) + " "
FNct Mc$, "**=", ChrW$(231) + " " + ChrW$(238) + " " + ChrW$(187) + " "
FNct Mc$, "-_****", ChrW$(214) + ChrW$(209) + ChrW$(239) + " " + ChrW$(232) + " " + ChrW$(232) + " " + ChrW$(236) + " "
FNct Mc$, "-X****", ChrW$(214) + ChrW$(61582) + "X" + ChrW$(239) + " " + ChrW$(232) + " " + ChrW$(232) + " " + ChrW$(236) + " "
FNct Mc$, "****", ChrW$(231) + " " + ChrW$(232) + " " + ChrW$(232) + " " + ChrW$(236) + " "
FNct Mc$, "d***", ChrW$(226) + " " + ChrW$(231) + " " + ChrW$(232) + " " + ChrW$(236) + " "
FNct Mc$, "===", ChrW$(61622) + " = " + ChrW$(187) + " "
FNct Mc$, "s.*=.*", ChrW$(225) + ". " + ChrW$(231) + " =." + ChrW$(236) + " "
FNct Mc$, "sd*=.*", ChrW$(225) + " " + ChrW$(226) + " " + ChrW$(231) + " =." + ChrW$(236) + " "
FNct Mc$, "=.*-", ChrW$(61622) + "." + ChrW$(241) + " " + ChrW$(181) + " "
FNct Mc$, "=.*=.*", ChrW$(61622) + "." + ChrW$(238) + " =." + ChrW$(236) + " "
FNct Mc$, "-.=", ChrW$(214) + "." + ChrW$(187) + " "
FNct Mc$, "**-**", ChrW$(231) + " " + ChrW$(241) + " - " + ChrW$(239) + " " + ChrW$(236) + " "
FNct Mc$, "-._-s", ChrW$(214) + "." + ChrW$(209) + ChrW$(181) + " " + ChrW$(225) + " "
FNct Mc$, "-._-", ChrW$(214) + "." + ChrW$(209) + ChrW$(181) + " "
FNct Mc$, "r==", ChrW$(224) + " " + ChrW$(61622) + " " + ChrW$(187) + " "
FNct Mc$, "s=-", ChrW$(225) + " " + ChrW$(61622) + " " + ChrW$(181) + " "
FNct Mc$, "-=", ChrW$(214) + " " + ChrW$(187) + " "
FNct Mc$, "=-", ChrW$(61622) + " " + ChrW$(181) + " "
FNct Mc$, "-_", ChrW$(181) + "_"
FNct Mc$, "-._", ChrW$(181) + "._"
FNct Mc$, "=_", ChrW$(187) + "_"
FNct Mc$, "*_", ChrW$(236) + "_"
FNct Mc$, "==", ChrW$(61622) + " " + ChrW$(187) + " "
FNct Mc$, "  ", " "
FNct Mc$, "r.", ChrW$(224) + ". "
FNct Mc$, "2.", ChrW$(61616) + ". "
FNct Mc$, "4.", ChrW$(61617) + ". "
FNct Mc$, "8.", ChrW$(196) + ". "
FNct Mc$, "16.", ChrW$(197) + ". "
FNct Mc$, "B", ChrW$(191) + " "
FNct Mc$, "w", ChrW$(229) + " "
FNct Mc$, "h", ChrW$(228) + " "
FNct Mc$, "r", ChrW$(224) + " "
FNct Mc$, "s", ChrW$(225) + " "
FNct Mc$, "d", ChrW$(226) + " "
FNct Mc$, "|O|", ChrW$(171) + " "
FNct Mc$, "16", ChrW$(197) + " "
FNct Mc$, "32", ChrW$(198) + " "
FNct Mc$, "64", ChrW$(199) + " "
FNct Mc$, "1", ChrW$(172) + " "
FNct Mc$, "2", ChrW$(61616) + " "
FNct Mc$, "4", ChrW$(61617) + " "
FNct Mc$, "8", ChrW$(196) + " "
FNct Mc$, "^", ChrW$(175)
FNct Mc$, "u", "_"
FNct Mc$, "|PG|", ChrW$(243)
FNct Mc$, "|||", ChrW$(243)
FNct Mc$, "(?)", ChrW$(249) + " "
FNct Mc$, "||", ChrW$(242)
FNct Mc$, "_|_", ChrW$(201)
FNct Mc$, "(@)", ChrW$(205)
FNct Mc$, "(#)", ChrW$(204)
FNct Mc$, "($)", ChrW$(208)
FNct Mc$, "(*)", ChrW$(135)
FNct Mc$, ChrW$(222) + "F", ChrW$(222) + "4"
FNct Mc$, ChrW$(222) + "H", ChrW$(222) + "3"
FNct Mc$, ChrW$(222) + "W", ChrW$(222) + "2"
FNct Mc$, ChrW$(222) + "O", ChrW$(222) + "1"

WordBasic.Font "bach"
WordBasic.Insert Mc$
WordBasic.Font original_font$

Finish:
End Sub

' ****************** Sub-routines **************************
Private Sub FNct(Mc$, Sch$, Repl$)
If InStr(Mc$, Sch$) > 0 Then
    FNreplace Mc$, Sch$, Repl$
End If
End Sub

Private Sub FNreplace(Mc$, Sch$, Repl$)
Dim curpos
Dim curlen
curpos = InStr(Mc$, Sch$) - 1
curlen = Len(Mc$) - curpos - Len(Sch$)
Mc$ = WordBasic.[Left$](Mc$, curpos) + Repl$ + WordBasic.[Right$](Mc$, curlen)
While InStr(Mc$, Sch$) > 0
    FNreplagain Mc$, Sch$, Repl$
Wend
End Sub

Private Sub FNreplagain(Mc$, Sch$, Repl$)
Dim curpos
Dim curlen
curpos = InStr(Mc$, Sch$) - 1
curlen = Len(Mc$) - curpos - Len(Sch$)
Mc$ = WordBasic.[Left$](Mc$, curpos) + Repl$ + WordBasic.[Right$](Mc$, curlen)
End Sub
Sub Bach_ornament_compiler()
'
' Bach_ornament_compiler Macro
' Macro created 04/01/01 by Yo Tomita
'
Dim original_font$
Dim Hd
Dim Wv
Dim Sr
Dim I
If WordBasic.SelInfo(27) Then WordBasic.MsgBox "Command not available in a macro window": GoTo Finish
original_font$ = WordBasic.[Font$]()
Starting:
WordBasic.BeginDialog 640, 200, "Bach: Ornament Compiler"
    WordBasic.Text 10, 75, 300, 16, "-- Grace --------------------------------"
    WordBasic.GroupBox 10, 0, 250, 189, "Head"
    WordBasic.OptionGroup "head"
        WordBasic.OptionButton 20, 18, 69, 16, "None"
        WordBasic.OptionButton 100, 18, 35, 16, "t"
        WordBasic.OptionButton 180, 18, 63, 16, "l (el)"
        WordBasic.OptionButton 180, 36, 60, 16, "^~~"
        WordBasic.OptionButton 100, 36, 55, 16, "'~~"
        WordBasic.OptionButton 100, 54, 61, 16, "c~~"
        WordBasic.OptionButton 180, 54, 60, 16, "C~~"
        WordBasic.OptionButton 20, 95, 151, 16, "crotchet (up)"
        WordBasic.OptionButton 20, 115, 130, 16, "quaver (up)"
        WordBasic.OptionButton 150, 115, 80, 16, "(down)"
        WordBasic.OptionButton 20, 135, 199, 16, "quaver (up + slash)"
        WordBasic.OptionButton 20, 155, 203, 16, "semiquaver (up)"
    WordBasic.CheckBox 45, 45, 40, 16, "r", "CheckBox5"
    WordBasic.GroupBox 270, 0, 155, 78, "Wave"
    WordBasic.OptionGroup "wave"
        WordBasic.OptionButton 288, 18, 69, 16, "None"
        WordBasic.OptionButton 365, 18, 39, 16, "1"
        WordBasic.OptionButton 288, 36, 39, 16, "2"
        WordBasic.OptionButton 365, 36, 39, 16, "3"
        WordBasic.OptionButton 288, 54, 39, 16, "4"
        WordBasic.OptionButton 365, 54, 39, 16, "5"
    WordBasic.GroupBox 270, 80, 155, 110, "Grace Slurs"
    WordBasic.OptionGroup "slurs"
        WordBasic.OptionButton 288, 95, 116, 16, "None"
        WordBasic.OptionButton 288, 113, 116, 16, "single, ^"
        WordBasic.OptionButton 288, 131, 109, 16, "single, v"
        WordBasic.OptionButton 288, 149, 123, 16, "double, high"
        WordBasic.OptionButton 288, 167, 116, 16, "double, low"
    WordBasic.GroupBox 435, 0, 192, 95, "Tails"
    WordBasic.CheckBox 445, 18, 123, 16, "standard trill", "CheckBox1"
    WordBasic.CheckBox 445, 36, 160, 16, "standard mordent", "CheckBox2"
    WordBasic.CheckBox 445, 54, 100, 16, "up ribbon", "CheckBox3"
    WordBasic.CheckBox 445, 72, 121, 16, "down ribbon", "CheckBox4"
    WordBasic.OKButton 432, 165, 92, 21
    WordBasic.CancelButton 534, 165, 88, 21
WordBasic.EndDialog
Dim Dlg As Object: Set Dlg = WordBasic.CurValues.UserDialog
Let Hd = 32
Let Wv = 32
Let Sr = 32
If WordBasic.Dialog.UserDialog(Dlg) Then
  WordBasic.Font "Bach"
  Select Case Dlg.head
    Case 1
      WordBasic.Insert ChrW$(255)
    Case 2
      WordBasic.Insert ChrW$(174)
    Case 3
      WordBasic.Insert ChrW$(94)
    Case 4
      WordBasic.Insert ChrW$(245)
    Case 5
      WordBasic.Insert ChrW$(246)
    Case 6
      WordBasic.Insert ChrW$(203)
    Case 7
      WordBasic.Insert ChrW$(192)
    Case 8
      WordBasic.Insert ChrW$(194)
    Case 9
      WordBasic.Insert ChrW$(195)
    Case 10
      WordBasic.Insert ChrW$(139)
    Case 11
      WordBasic.Insert ChrW$(193)
    Case Else
      WordBasic.Insert ""
  End Select
  If Dlg.CheckBox5 = 1 Then
    WordBasic.Insert ChrW$(251)
  End If
  For I = 1 To Dlg.wave
      WordBasic.Insert "~"
  Next I
  Select Case Dlg.slurs
    Case 1
      WordBasic.Insert ChrW$(61620)
    Case 2
      WordBasic.Insert ChrW$(61624)
    Case 3
      WordBasic.Insert ChrW$(200)
    Case 4
      WordBasic.Insert ChrW$(202)
    Case Else
      WordBasic.Insert ""
  End Select
  If Dlg.CheckBox1 = 1 Then
    WordBasic.Insert ChrW$(61692)
  End If
  If Dlg.CheckBox2 = 1 Then
    WordBasic.Insert ChrW$(61675)
  End If
  If Dlg.CheckBox3 = 1 Then
    WordBasic.Insert ChrW$(61687)
  End If
  If Dlg.checkbox4 = 1 Then
    WordBasic.Insert ChrW$(61688)
  End If
End If
WordBasic.Font original_font$
Finish:
End Sub
Sub Bach_font()
    Selection.Font.Name = "Bach"