Microsoft Office Forums - View Single Post

gmayor · 03-30-2015, 07:22 AM

The code was intended to be used instead of your existing code, but in the ThisDocument module, and not Module1. However all you need do is wrap the existing macro in a conditional statement e.g.

Code:

Sub AutoOpen()
Dim oVars As Variables
Dim oVar As Variable
Dim bVar As Boolean
Dim lngCount As Long
    If ThisDocument.Name = "Bestillingsskjema test v2-1.docm" Then
        Set oVars = ActiveDocument.Variables
        For Each oVar In oVars
            If oVar.Name = "varNum" Then
                bVar = True
                lngCount = oVar.Value + 1
                Exit For
            End If
        Next oVar
        If Not bVar Then lngCount = 1
        oVars("varNum").Value = lngCount
        UpdateAllFields
        ActiveDocument.Save
    End If
lbl_Exit:
    Exit Sub
End Sub

For this type of application you should be using a template and not a document which you appear to be renaming. Create new documents from the template and then you shouldn't have the problem. To do that replace all of the macros with the following macros and save as a macro enabled template DOTM format:

Code:

Option Explicit

Sub AutoNew()
Dim oVars As Variables
Dim oVar As Variable
Dim bVar As Boolean
Dim lngCount As Long
    Set oVars = ThisDocument.Variables
    For Each oVar In oVars
        If oVar.Name = "varNum" Then
            bVar = True
            lngCount = oVar.Value + 1
            Exit For
        End If
    Next oVar
    If Not bVar Then lngCount = 1
    oVars("varNum").Value = lngCount
    ActiveDocument.Variables("varNum").Value = lngCount
    UpdateAllFields ActiveDocument
    UpdateAllFields ThisDocument
    UpdateTemplate
lbl_Exit:
    Exit Sub
End Sub

Sub UpdateTemplate()
Dim bBackup As Boolean
    bBackup = Options.CreateBackup
    Options.CreateBackup = False
    ThisDocument.Save
    Options.CreateBackup = bBackup
lbl_Exit:
    Exit Sub
End Sub

Sub UpdateAllFields(oDoc as Document)
Dim oStory As Range
    For Each oStory In oDoc.StoryRanges
        oStory.Fields.Update
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Fields.Update
            Wend
        End If
    Next oStory
    Set oStory = Nothing
lbl_Exit:
    Exit Sub
End Sub