Just another note about using the macros and VBA. The latest versions of 97
with sp/2000 with sp/XP all have macros disabled by default.
After looking at the instructions, there is no reference as to how the user
would enable macros. The instructions list the way to select enable macros
if prompted. The newer security patches and software does not even prompt
you, but disables macros completely, where there are no prompts without
manual intervention. Also the enabling of the macros will also pose a
security risk and potential virus threat to those using the macro. This in
turn could cause much more harm then good, especially if the end-user is not
careful.
I have attached the vba code for the various macros as a text file. I have
tried it on a P4 XPsp1 system running Office XP SP2 and the macros do not
run. The runtime errors that I get I think are do to the difference in vba
global objects in the version I have. I have not tried them on another
version of windows or office as of yet. The version of vba I am running is
6.4.8869. I did also note that office XP is not a part of the "versions"
that could be used. Another item not listed is Microsoft works which uses
word from xp.
I can understand where the end-user would become frustrated with the various
processes to complete and then troubleshoot.
I still believe that the simplest path would be to use an alternative to
MSO.
Any thoughts?
Lester Nichols
"Embrace the Virtual Mindshare"
Network Engineer
Information Technology Services
[EMAIL PROTECTED]
www.lesternichols.com
Privileged/Confidential Information may be contained in this message. If
you are not the addressee indicated in this message (or responsible for
delivery of the message to such person), you may not directly or indirectly,
use, disclose, distribute, print, or copy any part of this message to
anyone. If you have received it in error please advise the sender
immediately by return email and then delete it and all copies from your
system. Community Bank reserves the right to monitor all e-mail
communications through its networks. Any views expressed in this message are
those of the individual sender, except where the message states otherwise
and the sender is authorized to state them to be the views of any such
entity. No contracts may be concluded on behalf of the sender by means of
electronic communications unless expressly stated to the contrary.
'*****************************************************************
'Macro: AboutEasyEnglish 26/June/00
'Displays the "About..." Dialogue Form and copyright notices.
'Modified: MJK - Decrease Form width for low resolution. 01/Apr/97
'*****************************************************************
Public Sub MAIN()
Dim ButtonClicked
WordBasic.BeginDialog 500, 200, "About EasyEnglish"
WordBasic.Text 142, 12, 330, 13, "EasyEnglish Issue 2.3(Word 97)", "Text1"
WordBasic.Text 142, 35, 330, 13, "Copyright © 1997-2000 Wycliffe Associates",
"Text2"
WordBasic.Text 142, 50, 330, 13, "All rights reserved.", "Text6"
WordBasic.Text 142, 73, 330, 13, "EasyEnglish and EasyEnglish Publications",
"Text4"
WordBasic.Text 142, 88, 330, 13, "are trademarks of Wycliffe Associates (UK).",
"Text7"
WordBasic.OKButton 388, 160, 88, 21
WordBasic.Picture 17, 11, 106, 92, "eelogo", 1, "Picture1"
WordBasic.EndDialog
Dim AboutDialog As Object: Set AboutDialog = WordBasic.CurValues.UserDialog
ButtonClicked = WordBasic.Dialog.UserDialog(AboutDialog)
End Sub
'*****************************************************************
'Macro: CheckGrammar 11/Mar/97
'Performs an EasyEnglish grammar check on the publication.
'Modified:
'*****************************************************************
Public Sub MAIN()
ActiveDocument.ActiveWritingStyle(wdEnglishUK) = "Custom"
WordBasic.ToolsOptionsGrammar CheckSpelling:=0, ShowStatistics:=0
WordBasic.ToolsGrammar
End Sub
'*****************************************************************
'Macro: CheckMeaning 5/Feb/99
'Lists the meanings of words.
'*****************************************************************
Public Sub MAIN()
Dim ReturnValue
ReturnValue = 0
ReturnValue = WordBasic.Call("EasyEnglishUtilities.fCheckMeaningWin")
End Sub
'*****************************************************************
'Macro: CheckReadability 11/Mar/97
'Perform a Flesch readability score on the publication.
'*****************************************************************
Public Sub MAIN()
Dim numstats
Dim MsgTitle$
Dim iScore
Dim EEmessage$
numstats = WordBasic.CountToolsGrammarStatistics() - 1
MsgTitle$ = "EasyEnglish Readability Score"
ReDim EEdocstats__$(numstats, 1)
WordBasic.ToolsGrammarStatisticsArray EEdocstats__$()
iScore = WordBasic.Val(EEdocstats__$(8, 1))
EEmessage$ = "The Flesch Reading Ease Index is " + EEdocstats__$(8, 1) + "."
'** Add minimum score comment if less than threshold
If iScore < 85 Then
WordBasic.MsgBox EEmessage$ + Chr(13) + "( You should aim at 85 or higher. )",
MsgTitle$, 64
Else
WordBasic.MsgBox EEmessage$ + Chr(13) + "( This meets the requirement of 85 or
higher. )", MsgTitle$, 64
End If
End Sub
'*****************************************************************
'Macro: CheckVocabulary 26/June/00
'Reads the document and highlights all the hard words.
'Added OKwords - 26/5/00
'Move cursor back to start of selection after checking - 26/5/00
'Skip the check if the language is NO PROOFING - 26/6/00
'*****************************************************************
Public Sub MAIN()
Dim PictureSetting
Dim FieldSetting
Dim DelimitedWord$
Dim InitialLetter$
Dim BlackLex$
'** Get current settings and save before changing
Dim dlgTOV As Object: Set dlgTOV = WordBasic.DialogRecord.ToolsOptionsView(False)
WordBasic.CurValues.ToolsOptionsView dlgTOV
PictureSetting = dlgTOV.PicturePlaceHolders
FieldSetting = dlgTOV.FieldCodes
WordBasic.ToolsOptionsView PicturePlaceHolders:=1, FieldCodes:=1
'** Set spelling options
With Options
.CheckSpellingAsYouType = True
.CheckGrammarAsYouType = True
.SuggestSpellingCorrections = True
.SuggestFromMainDictionaryOnly = False
.CheckGrammarWithSpelling = False
.ShowReadabilityStatistics = False
.IgnoreUppercase = True
.IgnoreMixedDigits = True
.IgnoreInternetAndFileAddresses = True
End With
ActiveDocument.ShowGrammaticalErrors = True
ActiveDocument.ShowSpellingErrors = True
'** Work out if it's a selection or the whole document
WordBasic.SetStartOfBookmark "\Sel", "StartPoint"
If WordBasic.SelType() = 2 Then
WordBasic.SetEndOfBookmark "\Sel", "EndPoint"
WordBasic.CharLeft
Else
WordBasic.CopyBookmark "\EndOfDoc", "EndPoint"
End If
'** Load the lexicon as a Global AddIn
Lexicon$ = ActiveDocument.AttachedTemplate.AutoTextEntries("Lexicon")
AddIns.Add FileName:=Lexicon$, Install:=True
'** Check the words
While WordBasic.CmpBookmarks("\Sel", "EndPoint") = 2
WordBasic.Call "FindNextWord"
If WordBasic.CmpBookmarks("\EndOfSel", "EndPoint") = 1 Then GoTo MACEND
DelimitedWord$ = LCase("~" + WordBasic.[Selection$]() + "~")
InitialLetter$ = WordBasic.[Left$](WordBasic.[Selection$](), 1)
'** Set the word colour
BlackLex$ = "black" + InitialLetter$
If Selection.LanguageID = wdNoProofing Then
'** don't check it if the language is NO PROOFING
ElseIf InStr(WordBasic.[GetAutoText$](BlackLex$, 0), DelimitedWord$) Then
WordBasic.CharColor 0 '** auto (black) word
ElseIf InStr(WordBasic.[GetAutoText$]("okwords", 0), DelimitedWord$) Then
WordBasic.CharColor 0 '** OK word (the TN OK list)
ElseIf InStr(WordBasic.[GetAutoText$]("greenwords", 0), DelimitedWord$) Then
WordBasic.CharColor 11 '** green word
ElseIf InStr(WordBasic.[GetAutoText$]("blue" + InitialLetter$, 0), DelimitedWord$)
Then
WordBasic.CharColor 2 '** blue word
Else
WordBasic.CharColor 6 '** red word
End If
Wend
MACEND:
WordBasic.WW7_EditGoTo "Startpoint"
WordBasic.ToolsOptionsView PicturePlaceHolders:=PictureSetting,
FieldCodes:=FieldSetting
'** Remove the lexicon from the Global AddIns list
AddIns(Lexicon$).Delete
End Sub
'*****************************************************************
'Macro: EasyEnglishHelp 4/Feb/99
'Call the EasyEnglish Help File
'*****************************************************************
Public Sub MAIN()
Dim Helpfile$
Helpfile$ = WordBasic.[GetAutoText$]("HelpFile", 1)
WordBasic.Shell Helpfile$, 1
End Sub
'*****************************************************************
'Macro: EasyEnglishUtilities 7/2/98
'Contains internal Functions & Subroutines.
'*****************************************************************
Public Sub MAIN()
End Sub
'*****************************************************************
'Purpose: Lists the meanings of words using MS Word 6. 23/Mar/97
'Accepts: Nothing.
'Returns: If OK Button Clicked = -1; If Cancel Button Clicked = 0
'*****************************************************************
Private Function fCheckMeaningWin()
Dim iPath$
Dim OriginalWord$
Dim IffyWord$
Dim LexName$
Dim ButtonClicked
Dim Count_
Dim iPosn
Dim SelectedMeaning$
On Error GoTo -1: On Error GoTo fCheckMeaningWinError
'** Select the nearest word
WordBasic.SelType 1
WordBasic.SelectCurWord
OriginalWord$ = WordBasic.[Selection$]()
IffyWord$ = "~" + WordBasic.[Selection$]() + "~"
'** Open the Lexicon
WordBasic.ScreenUpdating 0
LexName$ = WordBasic.[GetAutoText$]("Lexicon", 1) '** JW 23/3/97
WordBasic.FileOpen Name:=LexName$, ConfirmConversions:=0, ReadOnly:=1, AddToMru:=0,
PasswordDoc:="", PasswordDot:="", Revert:=0, WritePasswordDoc:="",
WritePasswordDot:="" 'JW 23/3/97
'** Find the headword from the lexicon
WordBasic.EditFindClearFormatting
WordBasic.EditFind Find:=IffyWord$, Direction:=0, MatchCase:=0, WholeWord:=0,
PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=1
If WordBasic.EditFindFound() = 0 Then
WordBasic.MsgBox "There are no EasyEnglish meanings for this word.",
"EasyEnglish", 64
WordBasic.FileClose
ButtonClicked = 0 'Simulate Cancel
WordBasic.ScreenUpdating 1
GoTo LABEL2
End If
WordBasic.ParaDown
'** Find up to 12 meanings
ReDim Meaning__$(12)
For Count_ = 0 To 11
WordBasic.ParaDown 1, 1
WordBasic.CharLeft 1, 1
Meaning__$(Count_) = WordBasic.[Selection$]()
If WordBasic.[Left$](Meaning__$(Count_), 1) <> "{" Then GoTo LABEL1
WordBasic.CharRight 2
Next Count_
LABEL1:
Meaning__$(Count_) = ""
WordBasic.FileClose
WordBasic.ScreenUpdating 1
'** Display the meanings
WordBasic.BeginDialog 692, 166, "EasyEnglish"
WordBasic.Text 10, 6, 360, 13, "Select a meaning for: " + OriginalWord$
WordBasic.ListBox 10, 25, 550, 122, Meaning__$(), "ListBox1"
WordBasic.OKButton 584, 25, 88, 21
WordBasic.CancelButton 584, 55, 88, 21
WordBasic.EndDialog
Dim Dlg As Object: Set Dlg = WordBasic.CurValues.UserDialog
ButtonClicked = WordBasic.Dialog.UserDialog(Dlg)
Select Case ButtonClicked
Case -1 'OK button clicked
iPosn = Dlg.ListBox1
If iPosn >= 0 Then
SelectedMeaning$ = Meaning__$(iPosn)
If Mid(SelectedMeaning$, 2, 1) > "B" Then
WordBasic.CharColor 6 'Set colour to red
WordBasic.CharLeft
Else
WordBasic.CharColor 0 'Set colour to black
WordBasic.CharRight
End If
Else
ButtonClicked = 0 'Simulate Cancel
End If
Case 0 'Cancel button clicked
End Select
GoTo LABEL2
fCheckMeaningWinError:
If Err.Number < 1000 Then
WordBasic.MsgBox "Error " + WordBasic.[LTrim$](Str(Err.Number)) + " Has
occurred.", _
"EasyEnglish", 64
End If
WordBasic.ScreenUpdating 1
ButtonClicked = 0 'Simulate Cancel
LABEL2:
fCheckMeaningWin = ButtonClicked
End Function
'*****************************************************************
'Macro: FindNextWord (Called by CheckVocabulary) 2/Apr/97
'Finds the next word in the document.
'*****************************************************************
Public Sub MAIN()
If WordBasic.SelType() = 2 Then WordBasic.WordRight
While InStr("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ",
WordBasic.[Selection$]()) = 0
WordBasic.WordRight
If WordBasic.CmpBookmarks("\Char", "\EndOfDoc") <> 2 Then GoTo ENDOFSUB
Wend
WordBasic.SelectCurWord
'** Check for genitives
If WordBasic.[Right$](WordBasic.[Selection$](), 2) = "’s" Then WordBasic.CharLeft 1, 2
If WordBasic.[Right$](WordBasic.[Selection$](), 1) = "’" Then WordBasic.CharLeft 1, 1
ENDOFSUB:
End Sub
'*****************************************************************
'Macro: FindSynonyms 8/7/98
'Finds EasyEnglish synonyms for a word.
'*****************************************************************
Public Sub MAIN()
Dim CleverCut
Dim OriginalWord$
Dim Numfound
Dim iPosn
Dim CurrentSyn$
Dim DelimitedSyn$
Dim Firstletter$
Dim BlackLex$
Dim ButtonClicked
Dim SynLength
Dim SelectedSyn$
Dim ReturnValue
ReDim iSynonyms__$(100) 'Internal array
'** Check for Smart Cut and Paste
Dim FunnyOptions As Object: Set FunnyOptions =
WordBasic.DialogRecord.ToolsOptionsEdit(False)
WordBasic.CurValues.ToolsOptionsEdit FunnyOptions
If FunnyOptions.SmartCutPaste = 1 Then
FunnyOptions.SmartCutPaste = 0
CleverCut = 1
WordBasic.ToolsOptionsEdit FunnyOptions
End If
'** Select the nearest word
WordBasic.SelType 1
WordBasic.SelectCurWord
'** Find all synonyms
OriginalWord$ = WordBasic.[Selection$]()
Numfound = WordBasic.ToolsGetSynonyms(iSynonyms__$())
If Numfound = 0 Then
WordBasic.MsgBox "Cannot find any synonyms for this word.", "EasyEnglish", 64
GoTo LABEL3
End If
'** Load the lexicon as a Global AddIn
Lexicon$ = ActiveDocument.AttachedTemplate.AutoTextEntries("Lexicon")
AddIns.Add FileName:=Lexicon$, Install:=True
'** Dim Dlg array to only contain found synonyms and fill it
ReDim Synonyms__$(Numfound - 1)
For iPosn = 0 To Numfound - 1
'** Append the word colour in brackets after the word
CurrentSyn$ = iSynonyms__$(iPosn)
DelimitedSyn$ = "~" + CurrentSyn$ + "~"
Firstletter$ = WordBasic.[Left$](CurrentSyn$, 1)
BlackLex$ = "black" + Firstletter$
If InStr(WordBasic.[GetAutoText$](BlackLex$, 0), DelimitedSyn$) Then
Synonyms__$(iPosn) = "Black: " + CurrentSyn$
ElseIf InStr(WordBasic.[GetAutoText$]("greenwords", 0), DelimitedSyn$) Then
Synonyms__$(iPosn) = "Green: " + CurrentSyn$
ElseIf InStr(WordBasic.[GetAutoText$]("glossary", 0), DelimitedSyn$) Then
Synonyms__$(iPosn) = "Gloss: " + CurrentSyn$
ElseIf InStr(WordBasic.[GetAutoText$]("blue" + Firstletter$, 0), DelimitedSyn$)
Then
Synonyms__$(iPosn) = "Blue: " + CurrentSyn$
Else
Synonyms__$(iPosn) = "Red: " + CurrentSyn$
End If
Next iPosn
'** Remove the lexicon from the Global AddIns list
AddIns(Lexicon$).Delete
WordBasic.SortArray Synonyms__$()
'** Display the dialog box
WordBasic.BeginDialog 356, 212, "EasyEnglish"
WordBasic.Text 10, 6, 320, 13, "Synonyms for: " + OriginalWord$
WordBasic.ListBox 12, 26, 322, 150, Synonyms__$(), "ListBox1"
WordBasic.OKButton 12, 183, 88, 21
WordBasic.CancelButton 246, 183, 88, 21
WordBasic.PushButton 128, 183, 88, 21, "Check"
WordBasic.EndDialog
Dim Syns As Object: Set Syns = WordBasic.CurValues.UserDialog
ButtonClicked = WordBasic.Dialog.UserDialog(Syns)
Select Case ButtonClicked
Case -1 '** OK button
iPosn = Syns.ListBox1
If iPosn >= 0 Then
'** Zap the colour name off the front of the synonym
SynLength = Len(Synonyms__$(iPosn)) - 12
SelectedSyn$ = WordBasic.[Right$](Synonyms__$(iPosn), SynLength)
WordBasic.EditCut 'Note: EditClear causes a Word 6 bug
WordBasic.CharColor 0
WordBasic.Insert SelectedSyn$
End If
Case 0 '** Cancel button
Case 1 '** Check button
iPosn = Syns.ListBox1
If iPosn >= 0 Then
'** Zap the colour name off the front of the synonym
SynLength = Len(Synonyms__$(iPosn)) - 12
SelectedSyn$ = WordBasic.[Right$](Synonyms__$(iPosn), SynLength)
If SelectedSyn$ <> "" Then
WordBasic.EditCut
WordBasic.Insert SelectedSyn$
WordBasic.WordLeft 1, 1
ReturnValue = 0
ReturnValue = WordBasic.Call("EasyEnglishUtilities.fCheckMeaningWin")
If ReturnValue <> -1 Then
WordBasic.EditCut
WordBasic.Insert OriginalWord$
WordBasic.WordLeft 1, 1
Else
WordBasic.CharColor 0
End If
End If
End If
End Select
LABEL3:
'** Reset Smart Cut and paste
If CleverCut = 1 Then WordBasic.ToolsOptionsEdit SmartCutPaste:=1
End Sub
'********************************************************************
'Macro: ResetCommonWords 5/Feb/99
'Turn all green words back to black.
'********************************************************************
Public Sub MAIN()
WordBasic.EditFindClearFormatting
WordBasic.EditReplaceClearFormatting
WordBasic.EditFindFont Color:=11
WordBasic.EditReplaceFont Color:=0
WordBasic.EditReplace Find:="", Replace:="", Direction:=0, MatchCase:=0, _
WholeWord:=0, PatternMatch:=0, SoundsLike:=0, ReplaceAll:=1, Format:=1, Wrap:=0
End Sub
Public Sub MAIN()
'
' ResetToBlack Macro
' Macro recorded 06/07/00 by John Williams
'
'** Set English UK words to Auto
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.LanguageID = wdEnglishUK
Selection.Find.Replacement.Font.ColorIndex = wdAuto
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
'** Set English (USA) to Auto
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.LanguageID = wdEnglishUS
Selection.Find.Replacement.Font.ColorIndex = wdAuto
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
'** Remove sticky settings
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
End Sub
'*****************************************************************
'Macro: SetOptions 11/Feb/99
'Sets EasyEnglish options
'*****************************************************************
Public Sub MAIN()
Dim Lexicon$
Dim Helpfile$
Dim ButtonClicked
Lexicon$ = WordBasic.[GetAutoText$]("Lexicon", 1)
Helpfile$ = WordBasic.[GetAutoText$]("HelpFile", 1)
WordBasic.BeginDialog 516, 126, "EasyEnglish Options"
WordBasic.Text 14, 14, 133, 13, "Lexicon:", "Text1"
WordBasic.Text 14, 49, 104, 13, "Help file:", "Text3"
WordBasic.OKButton 194, 89, 88, 21
WordBasic.CancelButton 406, 89, 88, 21
WordBasic.TextBox 194, 14, 300, 18, "DlgLexicon$"
WordBasic.TextBox 194, 47, 300, 18, "DlgHelpFile$"
WordBasic.EndDialog
Dim OptionsDialog As Object: Set OptionsDialog = WordBasic.CurValues.UserDialog
OptionsDialog.DlgLexicon$ = Lexicon$
OptionsDialog.DlgHelpFile$ = Helpfile$
ButtonClicked = WordBasic.Dialog.UserDialog(OptionsDialog)
'** If Cancel clicked do not save options
If ButtonClicked <> -1 Then GoTo ENDOFSUB
'** Save the options
Lexicon$ = OptionsDialog.DlgLexicon$
Helpfile$ = OptionsDialog.DlgHelpFile$
WordBasic.SetAutoText "Lexicon", Lexicon$, 1
WordBasic.SetAutoText "HelpFile", Helpfile$, 1
'** Check that the files exist - if not issue warnings
If Dir(Lexicon$) = "" Then WordBasic.MsgBox "Cannot find the lexicon", "EasyEnglish",
48
If Dir(Helpfile$) = "" Then WordBasic.MsgBox "Cannot find the help file",
"EasyEnglish", 48
'** Issue an OK message on the status bar
If Dir(Lexicon$) <> "" And Dir(Helpfile$) <> "" Then
WordBasic.MsgBox "The EasyEnglish options have been set successfully", -1
End If
ENDOFSUB:
End Sub
'********************************************************************
'Macro: ShowToolbar 26/May/00
'Displays the EasyEnglish Toolbar
'Modified 26/5/00 to move toolbar to (500,400)
'********************************************************************
Public Sub MAIN()
WordBasic.ViewToolbars ColorButtons:=1, ToolTips:=1
WordBasic.ViewToolbars Toolbar:="EasyEnglish", Show:=1
WordBasic.MoveToolbar "EasyEnglish", 0, 500, 400
End Sub
