Auto-rebuilding word templates

["Steve Hudson" <steve -at- wright -dot- com -dot- au>]

Sheesh. Four days later I am done. The WEIRD stuff Word can do. Heres a
short summary of what I learned:

1) If you customise shortcuts via the facade, not VBA, you canna find em in
the VBA KeyBindings collection. They only appear if programatically entered.

2) Std toolbars that have been customised still cant be copied to another
template via the organiser.

3) Autotext entries added to menus will have the .builtin property set to
True even though they are custom entries :-( The ID should be more than
sufficient.

4) Any code in ThisDocument cant be copied, so
activedocument.vbproject.components(1) can't be copied using the organiser.

5) Copying styles programatically using OrganizerCopy crashed Word 2K
spectacularly every time.

6) Couldn't find a way to programmatically add a digital signature to the
template.

7) Adding custom menu's via the facade doesn't name the commandbar that gets
created to hold them.

8) Custom menus' commandbars do not appear in the std cmdbar collection, yet
are addressable through such. Very weird. Ie, loop from 1 to 1000 and
debug.print the name or whatever - they aint there. Now index it by its
name - and its there! <shakes head in disbelief>

9) You cant add a pre-made commandbar to the collection and the copy method
for controls only works if source and target are 'real commandbars' in ya
face on screen. Thus it is impossible to use the copy method from one
template (customizationcontext) to another.

Now the solutions that require macros:

Firstly, lets synch the naming of your menus and the names of the
commandbars, a pre-req for copying:

Public Sub LabelMyToolBars()
    Dim cb As CommandBar
    For Each cb In CommandBars
        If cb.BuiltIn = True Then 'custom toolbars can be copied entire -
forget em
            LabelThisToolbar cb, cb.NameLocal
        End If
    Next
End Sub

Private Sub LabelThisToolbar(aToolbar As CommandBar, BarName As String)
    Dim aControl As CommandBarControl
    With aToolbar
        If Not .BuiltIn And .NameLocal <> BarName Then .NameLocal = BarName
        For Each aControl In .Controls
            With aControl
                If .Type = msoControlPopup Then
                    LabelThisToolbar .CommandBar, .Caption
                End If
            End With
        Next
    End With
End Sub


To get your customisations to the std toolbars collected:

Private Function GetAllCustomControlsFromStdToolbars() As Collection
    Dim cb As CommandBar
    Set GetAllCustomControlsFromStdToolbars = New Collection
    For Each cb In CommandBars
        If cb.BuiltIn = True Then
            GetCustomControls GetAllCustomControlsFromStdToolbars, cb
        End If
    Next
End Function

Private Sub GetCustomControls(TheCollection As Collection, aCommandBar As
CommandBar)
    Dim aControl As CommandBarControl
    Dim TheName As String
    Const InsAutoTextID As Long = 2205
    TheName = aCommandBar.NameLocal

    For Each aControl In aCommandBar.Controls
        If Not aControl.BuiltIn Or aControl.ID = InsAutoTextID Then 'save
this sucka
            TheCollection.Add TheName
            TheCollection.Add aControl
        End If
        'if another menu, explore it as well
        If aControl.Type = msoControlPopup Then GetCustomControls _
            TheCollection, aControl.CommandBar
    Next
End Sub


To get the customisations placed into the new template (once said template
is loaded natch)

Private Sub
PutAllCustomControlsOnStdToolbars(aCustomToolbarControlsCollection As
Collection)
    Dim k As Long, s As Long
    Dim Where As String, What As CommandBarControl, Here As CommandBar
    Dim This As CommandBarControl, That As CommandBarButton
    For k = 1 To aCustomToolbarControlsCollection.Count Step 2
        Where = aCustomToolbarControlsCollection(k)
        Set What = aCustomToolbarControlsCollection(k + 1)
        Set Here = CommandBars(Where)
        With What
            Set This = Here.Controls.Add(.Type, .ID, .Parameter, , False)
            This.BeginGroup = .BeginGroup
            This.Caption = .Caption
            This.DescriptionText = .DescriptionText
            This.Enabled = .Enabled
            This.OnAction = .OnAction
            This.Tag = .Tag
            This.TooltipText = .TooltipText
            This.Visible = .Visible
            If .Type = msoControlButton Then
                Set That = What
                That.CopyFace
                s = That.Style
                Set That = This
                That.PasteFace
                That.Style = s
            ElseIf .Type = msoControlPopup Then
                Set Here = This.CommandBar
                Here.NameLocal = This.Caption
            End If
        End With
    Next
End Sub


Now - to copy any code in ThisDocument use:

    With ActiveDocument.VBProject.VBComponents(1).CodeModule
        ThisDocumentCode = .Lines(2, .CountOfLines)
    End With

Note that it starts from line2 to avoid duplicate Options Explicit
statements - if you do not use this option in the VBE you will need to
change the 2 to a 1.

Whack it into the new (loaded) template with:

    Activedocument.VBProject.VBComponents(1).CodeModule.AddFromString
ThisDocumentCode


To tame the web toolbar to size:

Private Sub StripWebToolbar()
    With CommandBars("Web")
        While .Controls.Count > 3
            .Controls(4).Delete
        Wend
    End With
End Sub


To set your own shortcuts use code similar to

Private Sub AddStyleShortcuts()
    With Application.KeyBindings
        .Add wdKeyCategoryStyle, "Output", BuildKeyCode(wdKeyControl,
wdKeyO)
        .Add wdKeyCategoryStyle, "Input", BuildKeyCode(wdKeyControl, wdKeyI)
        .Add wdKeyCategoryStyle, "KeyPress", BuildKeyCode(wdKeyControl,
wdKeyK)
        .Add wdKeyCategoryStyle, "Emphasis", BuildKeyCode(wdKeyControl,
wdKeyB)
    End With
End Sub

Enjoy! I need a holiday now :-) Thats more word bugs in 4 days than in 4
months!

Steve Hudson , HDK List MVP
Wright Technologies Pty Ltd (Aus)





^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Collect Royalties, Not Rejection Letters! Tell us your rejection story when you 
submit your manuscript to iUniverse Nov. 6 -Dec. 15 and get five free copies of 
your book. What are you waiting for? http://www.iuniverse.com/media/techwr

Have you looked at the new content on TECHWR-L lately?
See http://www.raycomm.com/techwhirl/ and check it out.

---
You are currently subscribed to techwr-l as: archive -at- raycomm -dot- com
To unsubscribe send a blank email to leave-techwr-l-obscured -at- lists -dot- raycomm -dot- com
Send administrative questions to ejray -at- raycomm -dot- com -dot-  Visit 
http://www.raycomm.com/techwhirl/ for more resources and info.