Option Explicit
Sub SetSpacebar()
CustomizationContext = NormalTemplate
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
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
Selection.TypeText Text:=" "
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Set ec = Selection.Range.SpellingErrors
Selection.MoveRight Unit:=wdCharacter, Count:=1
If ec.Count > 0 Then
MsgBox "Pauses"
For i = 1 To 3
tm = Timer
Do
DoEvents
Loop Until Timer - tm > 0.15
Beep
Next i
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Decide = MsgBox("Add new word", 259, "Check Spelling")
If Decide = vbYes Then AddCustomWord
If Decide = vbNo Then DoEvents
If Decide = vbCancel Then Selection.MoveRight Unit:=wdCharacter, Count:=1
End If
End Sub
Sub AddCustomWord()
Dim NewWord As String, CustomWord As String
NewWord = Left(Selection, Len(Selection) - 1)
CustomWord = InputBox("Custom word to be added", , NewWord)
If CustomWord = "" Then Exit Sub
Documents.Open FileName:= _
"C:\Documents and Settings\USERNAME\Application Data\Microsoft\Proof\CUSTOM.DIC"
Selection.TypeText NewWord & Chr(13)
ActiveWindow.Close wdSaveChanges = True
Selection.MoveRight Unit:=wdCharacter, Count:=1
DoBeep 0.1, 2
End Sub
Sub DoBeep(Rate, Bps)
Dim i!, tm As Double
For i = 1 To Bps
tm = Timer
Do
DoEvents
Loop Until Timer - tm > Rate
Beep
Next i
End Sub
|