Word Template for Independent Documents with Macro Buttons

[ccsouthq]

Hello,

I'm working on a checklist template--rather than using a plain checkbox, I've set it up with macrobuttons to insert the user's initials & the date and time that the item was checked. It's organized such that the only macro in the template file is Document_New(), which inserts the macros into the created document and automatically opens a dialog box to save the new document as a docm.

The issue I'm having is that I don't know how to get the macrobutton fields in the created document to look for the referenced macro within its own VBComponents. I was able to get it to stop looking in the template file by setting the AttachedTemplate to normal, but that didn't completely solve the issue. I tried adding code to update the fields after saving, but that didn't seem to do the trick, either.

If I open the "Edit Field..." dialog box on one of the macrobuttons in the new document and hit "OK" (without changing anything), it works like a charm. But, if I try to double-click one of the macrobuttons without doing that, I get nothing. I'm sure I could code that action in, but I'm pretty sure there's something much more direct I could be doing here.

Attached in the zip file are:
1. A shell of the created document
2. A shell of the template

Anyone care to point out my folly? Thanks in advance--cc

[gmaxey]

It would be nice if you would verify your files are virsus free before asking others to look at them for you.

[ccsouthq]

I can confirm that I did not include any virus or otherwise malicious code in the attachment. Metascan (under MD5: 0FEFE9D4B62C0F1FA06402C7599BF7F5) shows a generic VBA "virus" detection, so I suppose that doesn't help my case. The only code included in the files is below:

The "new document" contains the following:

'Inserts the user's initials in the form of a macrobutton, so that when double-clicked, the initials reset to a blank check box
Sub InsertInitials(Target_Column As Long)
Dim ResetMacroName As String
If Target_Column = 1 Then
ResetMacroName = "Reset_NA "
ElseIf Target_Column = 3 Then
ResetMacroName = "Reset_Pending "
ElseIf Target_Column = 4 Then
ResetMacroName = "Reset_Complete "
Else: End If
ActiveWindow.View.ShowFieldCodes = True
With Selection
With .Font
.Name = "Cambria"
.Size = 10
.Bold = True
End With
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="USERINITIALS \* Upper", PreserveFormatting:=False
.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
.Fields.Update
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
.InsertAfter "MacroButton " & ResetMacroName
.Fields.Update
End With
ActiveWindow.View.ShowFieldCodes = False
End Sub


'Inserts the date and time that initials were inserted
Sub Date_Time(Target_Column As Long)
Dim DateShift As Long
DateShift = 5 - Target_Column
Selection.MoveRight Unit:=wdCell, Count:=DateShift
With Selection
With .Font
.Name = "Cambria"
.Size = 6
.Bold = False
End With
.InsertDateTime DateTimeFormat:="HH:mm:ss MM/dd/yyyy", InsertAsField:=False
End With
End Sub


'Resets the target macrobutton to its unchecked state
Sub Clear_Box(Clear_Column As Long)
Dim MacroName As String
Dim ClearShift As Long
ClearShift = 5 - Clear_Column
If Clear_Column = 1 Then
MacroName = "Initial_NA"
ElseIf Clear_Column = 3 Then
MacroName = "Initial_Pending"
ElseIf Clear_Column = 4 Then
MacroName = "Initial_Complete"
Else: End If
Selection.MoveLeft Unit:=wdCell, Count:=ClearShift
With Selection
With .Font
.Name = "MS Mincho"
.Size = 12
.Bold = False
End With
.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="MACROBUTTON " & MacroName & " " & ChrW(&H2610), PreserveFormatting:=False
End With
Selection.MoveRight Unit:=wdCell, Count:=ClearShift
End Sub


'Resets the target date-time cell
Sub Reset_Date(Target_Column As Long)
Dim DateShift As Long
DateShift = 5 - Target_Column
Selection.MoveRight Unit:=wdCell, Count:=DateShift
Selection.Delete
End Sub


'Inserts initials; adds date and time; resets the other macrobuttons on the same row to blank checkboxes
Sub Initial_NA()
Application.ScreenUpdating = False
Call InsertInitials(1)
Call Date_Time(1)
Call Clear_Box(3)
Call Clear_Box(4)
Application.ScreenUpdating = True
End Sub


'Inserts initials; adds date and time; resets the other macrobuttons on the same row to blank checkboxes
Sub Initial_Pending()
Application.ScreenUpdating = False
Call InsertInitials(3)
Call Date_Time(3)
Call Clear_Box(1)
Call Clear_Box(4)
Application.ScreenUpdating = True
End Sub


'Inserts initials; adds date and time; resets the other macrobuttons on the same row to blank checkboxes
Sub Initial_Complete()
Application.ScreenUpdating = False
Call InsertInitials(4)
Call Date_Time(4)
Call Clear_Box(1)
Call Clear_Box(3)
Application.ScreenUpdating = True
End Sub


'Resets macrobuttons & date from N/A column selection
Sub Reset_NA()
Application.ScreenUpdating = False
Call Reset_Date(1)
Call Clear_Box(1)
Call Clear_Box(3)
Call Clear_Box(4)
Application.ScreenUpdating = True
End Sub


'Resets macrobuttons & date from Pending column selection
Sub Reset_Pending()
Application.ScreenUpdating = False
Call Reset_Date(3)
Call Clear_Box(1)
Call Clear_Box(3)
Call Clear_Box(4)
Application.ScreenUpdating = True
End Sub


'Resets macrobuttons & date from Complete column selection
Sub Reset_Complete()
Application.ScreenUpdating = False
Call Reset_Date(4)
Call Clear_Box(1)
Call Clear_Box(3)
Call Clear_Box(4)
Application.ScreenUpdating = True
End Sub


The meat of the template code is the same as the above, so that all the subprocedures are copied into the new document upon creation:

Private Sub Document_New()
On Error Resume Next
Set VBCM = ActiveDocument.VBProject.VBComponents("ThisDocument").CodeModule
With VBCM
.InsertLines InsertLineIndex, "Option Explicit"
InsertLineIndex = .CountOfLines + 1
.InsertLines InsertLineIndex, "Sub InsertInitials(Target_Column As Long)"
InsertLineIndex = .CountOfLines + 1

...and so on...


.InsertLines InsertLineIndex, Chr(9) & "Application.ScreenUpdating = True"
InsertLineIndex = .CountOfLines + 1
.InsertLines InsertLineIndex, "End Sub" & Chr(13)
End With
Set VBCM = Nothing

With Application.Dialogs(wdDialogFileSaveAs)
.Format = 13
.Name = "Senior Review Checklist.docm"
.Show
End With
On Error GoTo 0

Word.ActiveDocument.AttachedTemplate = NormalTemplate

End Sub

[gmaxey]

I wasn't suggesting that it was intensional.

Have you considered simply putting the procedures in a single template module, exporting that module, and then importing it into the document suing document_new?

E.g., Say you put all of the procedures you want to appear in the document in a single module named "ExportImport" Then export that module to C:\

Sub Document_New()
ActiveDocument.VBProject.VBComponents.Import "C:\ExportImport.bas"
End Sub

[ccsouthq]

Have you considered simply putting the procedures in a single template module, exporting that module, and then importing it into the document suing document_new?


I hadn't thought of doing it that way--at one point I was trying to copy the module directly from the template to the new document, but I didn't have much luck. I'll give this a shot.

Thanks for the help--