Option Explicit 
 
Sub SetSpacebar() 
    CustomizationContext = NormalTemplate 
     'Create key binding
    KeyBindings.Add KeyCode:=BuildKeyCode(wdKeySpacebar), _ 
    KeyCategory:=wdKeyCategoryMacro, _ 
    Command:="CheckLastWord" 
    DoBeep 0.1, 2 
    MsgBox "Spacebar macro is on" 
End Sub 
 
Sub ClearSpacebar() 
    Dim aKey 
    CustomizationContext = NormalTemplate 
     'Look for key and delete if found, then exit sub
    For Each aKey In KeyBindings 
        If aKey.KeyString = "Space" Then 
            FindKey(BuildKeyCode(wdKeySpacebar)).Clear 
            DoBeep 0.1, 1 
            MsgBox "Spacebar Off" 
            Exit Sub 
        End If 
    Next aKey 
End Sub 
 
 
Sub CheckLastWord() 
    Dim ec As Object, i!, tm As Double, Decide As String 
     ' Insert a space
    Selection.TypeText Text:=" " 
     ' Select word just typed including space with cursor to left of word
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend 
     ' Set ec to count errors in selected text
    Set ec = Selection.Range.SpellingErrors 
     ' move cursor to the right of word just typed
    Selection.MoveRight Unit:=wdCharacter, Count:=1 
     ' Triple beep if there is an error
    If ec.Count > 0 Then 
         'Halt input until correction made
        MsgBox "Pauses" 
        For i = 1 To 3 'Set no. of beeps
            tm = Timer 
            Do 
                DoEvents 
            Loop Until Timer - tm > 0.15 'Set beep speed
            Beep 
        Next i 
         
         ' select the word just typed ready for retyping
        Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend 
         ' Now ask user if word is OK and to be added to dictionary
        Decide = MsgBox("Add new word", 259, "Check Spelling") 
         'Add word to dictionary
        If Decide = vbYes Then AddCustomWord 
         'Allows retyping of word
        If Decide = vbNo Then DoEvents 
         'Ignore and move on to next word
        If Decide = vbCancel Then Selection.MoveRight Unit:=wdCharacter, Count:=1 
         
    End If 
End Sub 
 
Sub AddCustomWord() 
    Dim NewWord As String, CustomWord As String 
     'Trim end space from selection
    NewWord = Left(Selection, Len(Selection) - 1) 
     'Enter as default on input box  This can be deleted if InputBox not desired
    CustomWord = InputBox("Custom word to be added", , NewWord) 
    If CustomWord = "" Then Exit Sub 
     'Set correct path to Custom.dic *******************************************
    Documents.Open FileName:= _ 
    "C:\Documents and Settings\USERNAME\Application Data\Microsoft\Proof\CUSTOM.DIC" 
    Selection.TypeText NewWord & Chr(13) 
    ActiveWindow.Close wdSaveChanges = True 
     'Move selection to continue typing
    Selection.MoveRight Unit:=wdCharacter, Count:=1 
     'Set beep response; Rate, Beeps
    DoBeep 0.1, 2 
End Sub 
 
Sub DoBeep(Rate, Bps) 
    Dim i!, tm As Double 
    For i = 1 To Bps 'Set no. of beeps
        tm = Timer 
        Do 
            DoEvents 
        Loop Until Timer - tm > Rate 'Set beep speed
        Beep 
    Next i 
End Sub