sailordickie
03-15-2010, 02:08 AM
Hi I am new to VBA macro programming and have been working on the code below I am almost happy with it except for once a user creates and saves a document based on my template, then re opens the newly created doc and edits it, during the auto spell check and prompt for save the user is prompted to save changes to original template even though its no longer open???
I have looked all over for an answer but am stuck with a deadline looming please help :-)
This document code
Option Explicit
Dim Cancelled As Boolean, myRange As Range, CorrectedError As String, oDoc As Document
Dim oSection As Section, OriginalRange As Range
Private Sub Document_New()
'Opens form for user to complete needed fields
frmBriefHeaderFooter.Show
End Sub
Private Sub Document_Close()
'Opens user form and prompts user to update version prior to saving
frmUpdateBriefDetails.Show
End Sub
Private Sub Document_Open()
'disables user from being able to select either track changes or protect
'document from Tools command bar
With Application.CommandBars("Menu Bar")
.Controls("Tools").Enabled = True
.Controls("Tools").Visible = True
With .Controls("Tools")
.Controls("Track Changes").Enabled = False
.Controls("Unprotect Document").Enabled = False
End With
End With
End Sub
User form code
Private Sub cmdClear_Click()
'clears all fields on user form
txt_brief_num = Null
txt_witness_name = Null
txt_witness_title = Null
txt_author_name = Null
txt_author_phone = Null
txt_version_date = Null
End Sub
Private Sub cmdCancel_Click()
'cancels creation of new brief document
Unload Me
ActiveDocument.Close SaveChanges:=False
End Sub
Private Sub cmdOK_Click()
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:="sfu"
End If
'copies text entered from userform to bookmarks on brief document
Application.ScreenUpdating = False
With ActiveDocument
UpdateBookmark "brief_num", txt_brief_num.Value
UpdateBookmark "witness_name", txt_witness_name.Value
UpdateBookmark "witness_title", txt_witness_title.Value
UpdateBookmark "author_name", txt_author_name.Value
UpdateBookmark "author_phone", txt_author_phone.Value
UpdateBookmark "version_date", txt_version_date.Value
End With
Application.ScreenUpdating = True
'Reprotect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sfu"
End If
Unload Me
End Sub
'sub process to update multiple bookmarks
Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String)
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
BMRange.Text = TextToUse
ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub
Private Sub UserForm_Click()
End Sub
Use form document close code
Option Explicit
Dim Cancelled As Boolean, myRange As Range, CorrectedError As String, oDoc As Document
Dim oSection As Section, OriginalRange As Range, newname As String, str1 As String
Dim ck As Boolean
Private Sub cmdSaveExit_Click()
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:="sfu"
End If
Application.ScreenUpdating = False
With ActiveDocument
'checks to see if user wants to update any fields
If txt_brief_num.Value = "" Then
Else
UpdateBookmark "brief_num", txt_brief_num.Value
End If
If txt_witness_name.Value = "" Then
Else
UpdateBookmark "witness_name", txt_witness_name.Value
End If
If txt_witness_title.Value = "" Then
Else
UpdateBookmark "witness_title", txt_witness_title.Value
End If
If txt_author_name.Value = "" Then
Else
UpdateBookmark "author_name", txt_author_name.Value
End If
If txt_author_phone.Value = "" Then
Else
UpdateBookmark "author_phone", txt_author_phone.Value
End If
If txt_version_date.Value = "" Then
Else
UpdateBookmark "version_date", txt_version_date.Value
End If
End With
Application.ScreenUpdating = True
'Reprotect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sfu"
End If
'If no documents open, quit macro
If Documents.Count = 0 Then
Exit Sub
End If
Set oDoc = ActiveDocument
'Check what type of protection - if any - has been applied
Select Case oDoc.ProtectionType
'If not protected, or if protected for tracked changes,
'run spellchecker and quit
'-------------
Case wdNoProtection, wdAllowOnlyRevisions
If Options.CheckGrammarWithSpelling Then
oDoc.CheckGrammar
Else
oDoc.CheckSpelling
End If
Application.ScreenUpdating = True
Application.ScreenRefresh
If oDoc.SpellingErrors.Count = 0 Then
If Options.CheckGrammarWithSpelling Then
MsgBox "The spelling and grammar check is complete", _
vbInformation
Else
MsgBox "The spelling check is complete", vbInformation
End If
End If
System.Cursor = wdCursorNormal
Exit Sub
'-------------
Case wdAllowOnlyComments
'Don't want to run spellchecker if protected for comments
Exit Sub
End Select
Set OriginalRange = Selection.Range
System.Cursor = wdCursorWait
'-------------
'-------------
'If we've got this far, it's protected for forms
'Now unprotect the document
oDoc.Unprotect Password:="sfu"
oDoc.SpellingChecked = False
'Check each section for its protection property -
'which you can get even after unprotecting the document.
'If the section was protected, call a subroutine to spellcheck the formfields.
'if it wasn't, spellcheck the section
StatusBar = "Spellchecking document ..."
For Each oSection In oDoc.Sections
If oSection.ProtectedForForms Then
Call CheckProtectedSection(oSection)
If Cancelled Then
'Boolean variable returned by CheckProtectedSection
'procedure if user pressed Cancel button
Exit For
End If
Else
If oSection.Range.SpellingErrors.Count > 0 Then
Application.ScreenUpdating = True
oSection.Range.CheckSpelling
If oSection.Range.SpellingErrors.Count > 0 Then
'User pressed Cancel button
'(Pressing Ignore reduces the count, pressing Cancel doesn't)
Exit For
End If
End If
End If
Next oSection
'Re-protect the document
oDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sfu"
OriginalRange.Select
Application.ScreenUpdating = True
Application.ScreenRefresh
If oDoc.Range.SpellingErrors.Count = 0 Then
If Options.CheckGrammarWithSpelling Then
MsgBox "The spelling and grammar check is complete", _
vbInformation
Else
MsgBox "The spelling check is complete", vbInformation
End If
End If
'Release variables from memory
System.Cursor = wdCursorNormal
Cancelled = False
CorrectedError = vbNullString
Set myRange = Nothing
' SaveBrief Macro
Dim ck As Boolean
If newname = "" Then
str1 = "Enter New File Name Here"
Else
str1 = newname
End If
ck = Application.Dialogs(wdDialogFileSaveAs).Show(str1)
If ck = True Then
newname = ActiveDocument.Name
End If
'Close Document and Quit Word
Dim objWord As Word.Document
Set objWord = ActiveDocument
objWord.Application.Quit
Set objWord = Nothing
End Sub
Private Sub CheckProtectedSection(oSection As Section)
Dim FmFld As FormField, FmFldCount As Long, Pos As Long
'check only the text formfields,
'don't check listboxes and checkboxes - this speeds up the code
Application.ScreenUpdating = False
For Each FmFld In oSection.Range.FormFields
'Check to see if the field is a text formfield
If FmFld.Type = wdFieldFormTextInput Then
'Check if the field is a 'real' text field (no date, formula etc);
'and that it is enabled for text input
If FmFld.TextInput.Type = wdRegularText And FmFld.Enabled Then
'The following subroutine won't be called if Word 97 is in use
If Not Left$(Application.Version, 1) = "8" Then
Call TurnNoProofingOff(FmFld)
End If
FmFld.Range.SpellingChecked = False
'Change the language constant in the following line if necessary;
'when you type the = sign, a list of all supported language
'constants will appear, and you can choose one from the list.
FmFld.Range.LanguageID = wdEnglishUS
'Or whichever language is appropriate for you
'If the current form field contains errors, spellcheck the text in it
If FmFld.Range.SpellingErrors.Count > 0 Then
'The following condition is to allow for a Word 97 bug, which
'was fixed in 2000; (and in the latest Word 97 patches). If
'the formfield is in a table and contains more than one
'paragraph, then spellchecking it will crash Word 97
If Left$(Application.Version, 1) = "8" _
And FmFld.Range.Paragraphs.Count > 1 _
And FmFld.Range.Tables.Count > 0 Then
Call Word97TableBugWorkaround(FmFld)
If Cancelled Then Exit Sub
Else
'Set a range to the formfield's range in case the user
'accidentally destroys the formfield by overtyping its entire
'contents
Set myRange = FmFld.Range
FmFldCount = oSection.Range.FormFields.Count
Application.ScreenUpdating = True
FmFld.Range.CheckSpelling
If IsObjectValid(FmFld) Then
If FmFld.Range.SpellingErrors.Count > 0 Then
'User pressed Cancel button. (Pressing Ignore
'reduces the count, pressing Cancel doesn't)
Cancelled = True
Exit Sub
End If
Else
'If formfield was destroyed because user overtyped its
'entire contents
CorrectedError = myRange.Text
If Len(CorrectedError) = 0 Then
CorrectedError = myRange.Words(1).Text
End If
'Formfields should really NEVER be preceded by a tab;
'design your forms so that each formfield is in its own
'table cell (removing borders as necessary). However, to
'cater for any legacy forms you may have, the following
'loop works around the possibility that it might be
'preceded by a tab
Pos = InStr(CorrectedError, vbTab)
Do While Pos > 0
CorrectedError = Mid$(CorrectedError, Pos + 1)
Pos = InStr(CorrectedError, vbTab)
Loop
'If formfield was destroyed when the user corrected the
'spelling, reinstate it, and put the user's correction into its
'result. Note that although Undo reinstates the Formfield
'itself, if the Formfield is preceded by a tab, It doesn't
'reinstate the FmFld object, hence the need to do a count
'(although, as previously stated, in a well-designed form,
'formfields should never be preceded by a tab, as it's
'better use table cells (removing borders as necessary).
Do While Not FmFldCount = _
oSection.Range.FormFields.Count
oDoc.Undo
Loop
'Also due to a Word bug, if the formfield is preceded by a
'tab, the text within the formfield may now be selected
'without the formfield itself being selected!
'Hence the following convoluted workaround
If Selection.FormFields.Count = 0 Then
Selection.MoveRight unit:=wdCharacter
Selection.MoveLeft unit:=wdCharacter, Extend:=True
End If
If Not IsObjectValid(FmFld) Then
Set FmFld = Selection.FormFields(1)
End If
FmFld.Result = CorrectedError
End If
End If
Application.ScreenUpdating = False
End If
End If
End If
Next FmFld
End Sub
Private Sub TurnNoProofingOff(FmFld As FormField)
'This subroutine is called only in Word 2000 and above
FmFld.Range.NoProofing = False
End Sub
Private Sub Word97TableBugWorkaround(FmFld As FormField)
'Unlink formfield (convert to text)
Set myRange = FmFld.Range
FmFld.Range.Fields(1).Unlink
Application.ScreenUpdating = True
myRange.CheckSpelling
If myRange.SpellingErrors.Count > 0 Then
'User pressed Cancel button
'(Pressing Ignore reduces the count, pressing Cancel doesn't)
Cancelled = True
End If
CorrectedError = myRange.Text
'Undo to reinstate the formfield
Do While Not IsObjectValid(FmFld)
oDoc.Undo
Loop
FmFld.Range.Fields(1).Result.Text = CorrectedError
Application.ScreenUpdating = False
End Sub
Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String)
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
BMRange.Text = TextToUse
ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub
Private Sub UserForm_Click()
End Sub
I have looked all over for an answer but am stuck with a deadline looming please help :-)
This document code
Option Explicit
Dim Cancelled As Boolean, myRange As Range, CorrectedError As String, oDoc As Document
Dim oSection As Section, OriginalRange As Range
Private Sub Document_New()
'Opens form for user to complete needed fields
frmBriefHeaderFooter.Show
End Sub
Private Sub Document_Close()
'Opens user form and prompts user to update version prior to saving
frmUpdateBriefDetails.Show
End Sub
Private Sub Document_Open()
'disables user from being able to select either track changes or protect
'document from Tools command bar
With Application.CommandBars("Menu Bar")
.Controls("Tools").Enabled = True
.Controls("Tools").Visible = True
With .Controls("Tools")
.Controls("Track Changes").Enabled = False
.Controls("Unprotect Document").Enabled = False
End With
End With
End Sub
User form code
Private Sub cmdClear_Click()
'clears all fields on user form
txt_brief_num = Null
txt_witness_name = Null
txt_witness_title = Null
txt_author_name = Null
txt_author_phone = Null
txt_version_date = Null
End Sub
Private Sub cmdCancel_Click()
'cancels creation of new brief document
Unload Me
ActiveDocument.Close SaveChanges:=False
End Sub
Private Sub cmdOK_Click()
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:="sfu"
End If
'copies text entered from userform to bookmarks on brief document
Application.ScreenUpdating = False
With ActiveDocument
UpdateBookmark "brief_num", txt_brief_num.Value
UpdateBookmark "witness_name", txt_witness_name.Value
UpdateBookmark "witness_title", txt_witness_title.Value
UpdateBookmark "author_name", txt_author_name.Value
UpdateBookmark "author_phone", txt_author_phone.Value
UpdateBookmark "version_date", txt_version_date.Value
End With
Application.ScreenUpdating = True
'Reprotect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sfu"
End If
Unload Me
End Sub
'sub process to update multiple bookmarks
Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String)
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
BMRange.Text = TextToUse
ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub
Private Sub UserForm_Click()
End Sub
Use form document close code
Option Explicit
Dim Cancelled As Boolean, myRange As Range, CorrectedError As String, oDoc As Document
Dim oSection As Section, OriginalRange As Range, newname As String, str1 As String
Dim ck As Boolean
Private Sub cmdSaveExit_Click()
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:="sfu"
End If
Application.ScreenUpdating = False
With ActiveDocument
'checks to see if user wants to update any fields
If txt_brief_num.Value = "" Then
Else
UpdateBookmark "brief_num", txt_brief_num.Value
End If
If txt_witness_name.Value = "" Then
Else
UpdateBookmark "witness_name", txt_witness_name.Value
End If
If txt_witness_title.Value = "" Then
Else
UpdateBookmark "witness_title", txt_witness_title.Value
End If
If txt_author_name.Value = "" Then
Else
UpdateBookmark "author_name", txt_author_name.Value
End If
If txt_author_phone.Value = "" Then
Else
UpdateBookmark "author_phone", txt_author_phone.Value
End If
If txt_version_date.Value = "" Then
Else
UpdateBookmark "version_date", txt_version_date.Value
End If
End With
Application.ScreenUpdating = True
'Reprotect the document.
If ActiveDocument.ProtectionType = wdNoProtection Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sfu"
End If
'If no documents open, quit macro
If Documents.Count = 0 Then
Exit Sub
End If
Set oDoc = ActiveDocument
'Check what type of protection - if any - has been applied
Select Case oDoc.ProtectionType
'If not protected, or if protected for tracked changes,
'run spellchecker and quit
'-------------
Case wdNoProtection, wdAllowOnlyRevisions
If Options.CheckGrammarWithSpelling Then
oDoc.CheckGrammar
Else
oDoc.CheckSpelling
End If
Application.ScreenUpdating = True
Application.ScreenRefresh
If oDoc.SpellingErrors.Count = 0 Then
If Options.CheckGrammarWithSpelling Then
MsgBox "The spelling and grammar check is complete", _
vbInformation
Else
MsgBox "The spelling check is complete", vbInformation
End If
End If
System.Cursor = wdCursorNormal
Exit Sub
'-------------
Case wdAllowOnlyComments
'Don't want to run spellchecker if protected for comments
Exit Sub
End Select
Set OriginalRange = Selection.Range
System.Cursor = wdCursorWait
'-------------
'-------------
'If we've got this far, it's protected for forms
'Now unprotect the document
oDoc.Unprotect Password:="sfu"
oDoc.SpellingChecked = False
'Check each section for its protection property -
'which you can get even after unprotecting the document.
'If the section was protected, call a subroutine to spellcheck the formfields.
'if it wasn't, spellcheck the section
StatusBar = "Spellchecking document ..."
For Each oSection In oDoc.Sections
If oSection.ProtectedForForms Then
Call CheckProtectedSection(oSection)
If Cancelled Then
'Boolean variable returned by CheckProtectedSection
'procedure if user pressed Cancel button
Exit For
End If
Else
If oSection.Range.SpellingErrors.Count > 0 Then
Application.ScreenUpdating = True
oSection.Range.CheckSpelling
If oSection.Range.SpellingErrors.Count > 0 Then
'User pressed Cancel button
'(Pressing Ignore reduces the count, pressing Cancel doesn't)
Exit For
End If
End If
End If
Next oSection
'Re-protect the document
oDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="sfu"
OriginalRange.Select
Application.ScreenUpdating = True
Application.ScreenRefresh
If oDoc.Range.SpellingErrors.Count = 0 Then
If Options.CheckGrammarWithSpelling Then
MsgBox "The spelling and grammar check is complete", _
vbInformation
Else
MsgBox "The spelling check is complete", vbInformation
End If
End If
'Release variables from memory
System.Cursor = wdCursorNormal
Cancelled = False
CorrectedError = vbNullString
Set myRange = Nothing
' SaveBrief Macro
Dim ck As Boolean
If newname = "" Then
str1 = "Enter New File Name Here"
Else
str1 = newname
End If
ck = Application.Dialogs(wdDialogFileSaveAs).Show(str1)
If ck = True Then
newname = ActiveDocument.Name
End If
'Close Document and Quit Word
Dim objWord As Word.Document
Set objWord = ActiveDocument
objWord.Application.Quit
Set objWord = Nothing
End Sub
Private Sub CheckProtectedSection(oSection As Section)
Dim FmFld As FormField, FmFldCount As Long, Pos As Long
'check only the text formfields,
'don't check listboxes and checkboxes - this speeds up the code
Application.ScreenUpdating = False
For Each FmFld In oSection.Range.FormFields
'Check to see if the field is a text formfield
If FmFld.Type = wdFieldFormTextInput Then
'Check if the field is a 'real' text field (no date, formula etc);
'and that it is enabled for text input
If FmFld.TextInput.Type = wdRegularText And FmFld.Enabled Then
'The following subroutine won't be called if Word 97 is in use
If Not Left$(Application.Version, 1) = "8" Then
Call TurnNoProofingOff(FmFld)
End If
FmFld.Range.SpellingChecked = False
'Change the language constant in the following line if necessary;
'when you type the = sign, a list of all supported language
'constants will appear, and you can choose one from the list.
FmFld.Range.LanguageID = wdEnglishUS
'Or whichever language is appropriate for you
'If the current form field contains errors, spellcheck the text in it
If FmFld.Range.SpellingErrors.Count > 0 Then
'The following condition is to allow for a Word 97 bug, which
'was fixed in 2000; (and in the latest Word 97 patches). If
'the formfield is in a table and contains more than one
'paragraph, then spellchecking it will crash Word 97
If Left$(Application.Version, 1) = "8" _
And FmFld.Range.Paragraphs.Count > 1 _
And FmFld.Range.Tables.Count > 0 Then
Call Word97TableBugWorkaround(FmFld)
If Cancelled Then Exit Sub
Else
'Set a range to the formfield's range in case the user
'accidentally destroys the formfield by overtyping its entire
'contents
Set myRange = FmFld.Range
FmFldCount = oSection.Range.FormFields.Count
Application.ScreenUpdating = True
FmFld.Range.CheckSpelling
If IsObjectValid(FmFld) Then
If FmFld.Range.SpellingErrors.Count > 0 Then
'User pressed Cancel button. (Pressing Ignore
'reduces the count, pressing Cancel doesn't)
Cancelled = True
Exit Sub
End If
Else
'If formfield was destroyed because user overtyped its
'entire contents
CorrectedError = myRange.Text
If Len(CorrectedError) = 0 Then
CorrectedError = myRange.Words(1).Text
End If
'Formfields should really NEVER be preceded by a tab;
'design your forms so that each formfield is in its own
'table cell (removing borders as necessary). However, to
'cater for any legacy forms you may have, the following
'loop works around the possibility that it might be
'preceded by a tab
Pos = InStr(CorrectedError, vbTab)
Do While Pos > 0
CorrectedError = Mid$(CorrectedError, Pos + 1)
Pos = InStr(CorrectedError, vbTab)
Loop
'If formfield was destroyed when the user corrected the
'spelling, reinstate it, and put the user's correction into its
'result. Note that although Undo reinstates the Formfield
'itself, if the Formfield is preceded by a tab, It doesn't
'reinstate the FmFld object, hence the need to do a count
'(although, as previously stated, in a well-designed form,
'formfields should never be preceded by a tab, as it's
'better use table cells (removing borders as necessary).
Do While Not FmFldCount = _
oSection.Range.FormFields.Count
oDoc.Undo
Loop
'Also due to a Word bug, if the formfield is preceded by a
'tab, the text within the formfield may now be selected
'without the formfield itself being selected!
'Hence the following convoluted workaround
If Selection.FormFields.Count = 0 Then
Selection.MoveRight unit:=wdCharacter
Selection.MoveLeft unit:=wdCharacter, Extend:=True
End If
If Not IsObjectValid(FmFld) Then
Set FmFld = Selection.FormFields(1)
End If
FmFld.Result = CorrectedError
End If
End If
Application.ScreenUpdating = False
End If
End If
End If
Next FmFld
End Sub
Private Sub TurnNoProofingOff(FmFld As FormField)
'This subroutine is called only in Word 2000 and above
FmFld.Range.NoProofing = False
End Sub
Private Sub Word97TableBugWorkaround(FmFld As FormField)
'Unlink formfield (convert to text)
Set myRange = FmFld.Range
FmFld.Range.Fields(1).Unlink
Application.ScreenUpdating = True
myRange.CheckSpelling
If myRange.SpellingErrors.Count > 0 Then
'User pressed Cancel button
'(Pressing Ignore reduces the count, pressing Cancel doesn't)
Cancelled = True
End If
CorrectedError = myRange.Text
'Undo to reinstate the formfield
Do While Not IsObjectValid(FmFld)
oDoc.Undo
Loop
FmFld.Range.Fields(1).Result.Text = CorrectedError
Application.ScreenUpdating = False
End Sub
Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String)
Dim BMRange As Range
Set BMRange = ActiveDocument.Bookmarks(BookmarkToUpdate).Range
BMRange.Text = TextToUse
ActiveDocument.Bookmarks.Add BookmarkToUpdate, BMRange
End Sub
Private Sub UserForm_Click()
End Sub