Optionally copy named style to document upon open

[Charles Kenyon]

I am trying to write an AutoOpen macro to optionally copy a single named style in the normal template to the active document.

It first checks for a document variable named "Checked" in the activedocument.
If the variable exists but does not have the value "True" then it asks the user if the style is to be copied. Upon a "No" response, exits.

If I comment out:

Code: Select all

    On Error GoTo ContinueSub
    If ActiveDocument.Variables("Checked") = True Then GoTo ExitSub

this runs fine.

Code: Select all

Sub AutoOpen() ' PLACE IN NORMAL TEMPLATE
'   Charles Kenyon
'   Optionally copies a particular style from the normal template into an existing document.
    Const strSTYLENAME As String = "MyStyle"    '  Replace "MyStyle" with the name of the Style you want to copy
    '
    Dim msgResponse As VbMsgBoxResult
    Dim strChecked As String
    '
    '   CHECK TO SEE WHETHER OR NOT THE DOCUMENT BEING OPENED HAS ALREADY BEEN UPDATED
    On Error GoTo ContinueSub
    If ActiveDocument.Variables("Checked") = True Then GoTo ExitSub
ContinueSub:
    '
    '   ASK WHETHER USER WANTS TO ADD STYLE
    msgResponse = MsgBox(Prompt:="Do you want to copy the style " & strSTYLENAME & " to this document?", _
        Title:="Copy " & strSTYLENAME & " Style?", _
        Buttons:=vbYesNo)
    If msgResponse = vbNo Then GoTo ExitSub
    On Error GoTo Oops
    Application.OrganizerCopy Source:=ThisDocument.FullName, _
        Destination:=ActiveDocument, _
        Name:=strSTYLENAME, _
        Object:=wdOrganizerObjectStyles
    ActiveDocument.Variables.Add "Checked", True
    GoTo ExitSub
Oops:
    MsgBox Prompt:="The Style " & strSTYLENAME & " does not exist in this template.", Buttons:=vbCritical
ExitSub:
    On Error GoTo -1
End Sub

[HansV]

I'd do it like this:

Code: Select all

Sub AutoOpen() ' PLACE IN NORMAL TEMPLATE
'   Charles Kenyon
'   Optionally copies a particular style from the normal template into an existing document.
    Const strSTYLENAME As String = "MyStyle"    '  Replace "MyStyle" with the name of the Style you want to copy
    '
    Dim msgResponse As VbMsgBoxResult
    Dim blnChecked As Boolean
    '
    '   CHECK TO SEE WHETHER OR NOT THE DOCUMENT BEING OPENED HAS ALREADY BEEN UPDATED
    On Error Resume Next
    blnChecked = ActiveDocument.Variables("Checked")
    On Error GoTo Oops
    If Not blnChecked Then
        '
        '   ASK WHETHER USER WANTS TO ADD STYLE
        msgResponse = MsgBox(Prompt:="Do you want to copy the style " & strSTYLENAME & " to this document?", _
            Title:="Copy " & strSTYLENAME & " Style?", _
            Buttons:=vbYesNo)
        If msgResponse = vbYes Then
            Application.OrganizerCopy Source:=ThisDocument.FullName, _
                Destination:=ActiveDocument, _
                Name:=strSTYLENAME, _
                Object:=wdOrganizerObjectStyles
            ActiveDocument.Variables("Checked") = True
        End If
    End If
    Exit Sub
Oops:
    MsgBox Prompt:="The Style " & strSTYLENAME & " does not exist in this template.", Buttons:=vbCritical
End Sub

[Charles Kenyon]

Thank you Hans. It works well.
I've added it to the Troubleshooting section of my webpage on styles.
Macros to Copy Styles from the Normal Template