Results 1 to 6 of 6
  1. #1
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Christchurch, New Zealand
    Posts
    250
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Word 2010: Quick Parts footers not behaving when inserted with macro

    I've been playing with Quick Parts and loving being able to create a Quick Parts building block that I assigned either to a footer or a watermark gallery.

    I've been using the Building Blocks Organiser to insert quick parts, and love it. When I select a building block that is assigned to the footer gallery it automatically opens the footer and inserts it and all I have to do is close the footer.

    When I select a building block that is assigned to the watermark gallery it puts the watemark in the header.

    However, when I then use VBA to insert the quick part I get different results:

    The footer quick part gets added to the header.
    The watermark quick part doesn't get added to the header, it just appears on the current page of the document, behind text.

    This is the code I'm using. I really hope someone can point out where I'm going wrong. This code works beautifully for standard autotext entries that just have to appear at the insertion point, and who have been assigned to the autotext gallery.


    Code:
    Public strAutotext As String
    Sub InsertLAAutotext()
    Dim strMasterTemplate As Template
    Dim colAutoText As AutoTextEntries
    Dim objAutoText As AutoTextEntry
    'Dim arrEntries As Variant
    Dim i As Integer
    Templates.LoadBuildingBlocks
    i = 1
    For Each atemp In Templates
        If atemp = "Legal Assist Building Blocks.dotx" Then Set strMasterTemplate = Templates(i)
        i = i + 1
    Next atemp
    ReDim arrEntries(0)
    Set colAutoText = strMasterTemplate.AutoTextEntries
    For Each objAutoText In colAutoText
        Bound = UBound(arrEntries)
            If arrEntries(Bound) = "" Then
                arrEntries(Bound) = objAutoText.Name
            Else
                ReDim Preserve arrEntries(Bound + 1)
                arrEntries(Bound + 1) = objAutoText.Name
            End If
    Next objAutoText
    strMasterTemplate.BuildingBlockEntries(strAutotext). _
        Insert Where:=Selection.Range, RichText:=True
    
    End Sub
    Sub WatermarkFileCopy()
         strAutotext = "FileCopy"
        Call InsertLAAutotext
        
    End Sub
    Sub WatermarkConfidential()
       strAutotext = "Confidential"
       Call InsertLAAutotext
    End Sub
    Sub WatermarkDraft()
        strAutotext = "Draft"
        Call InsertLAAutotext
    End Sub
    Sub RemoveWatermark()
        Application.ScreenUpdating = False
        Dim RngSel As Range, Scn As Section, HdFt As HeaderFooter, iView As Long
        With ActiveDocument
            Set RngSel = Selection.Range
            iView = ActiveWindow.View.Type
            For Each Scn In .Sections
                For Each HdFt In Scn.Headers
                    HdFt.Range.Select
                    WordBasic.RemoveWatermark
                Next
    '            For Each HdFt In Scn.Footers
    '                HdFt.Range.Select
    '                WordBasic.RemoveWatermark
    '            Next
            Next
        End With
    
        RngSel.Select
        ActiveWindow.View.Type = iView
        Set RngSel = Nothing
        Application.ScreenUpdating = True
    End Sub

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Try replacing the public declaration and first few macros with the following
    Code:
    Function InsertLAAutotext(strAutotext As String)
    
      Dim strMasterTemplate As Template, atemp As Template
      Templates.LoadBuildingBlocks
      For Each atemp In Templates
        Debug.Print atemp.Name
        If atemp = "Legal Assist Building Blocks.dotx" Then
          Set strMasterTemplate = atemp
          Exit For
        End If
      Next atemp
      strMasterTemplate.BuildingBlockEntries(strAutotext).Insert _
           Where:=Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range, RichText:=True
    End Function
    Sub WatermarkFileCopy()
      InsertLAAutotext "FileCopy"
    End Sub
    Sub WatermarkConfidential()
      InsertLAAutotext "Confidential"
    End Sub
    Sub WatermarkDraft()
      InsertLAAutotext "Draft"
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. #3
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Christchurch, New Zealand
    Posts
    250
    Thanks
    1
    Thanked 0 Times in 0 Posts
    Thank you Andrew. That works beautifully for the watermarks. Is there anyway I select whether it goes into a header or footer (or just at the insertion point). This is because we use the building blocks for other things as well - some go into footers, and some just in the document in the insertion point?

    I could copy the function and create one for each of the options, but I just wonder how I would go about making it generic for all insertions of autotext.

  4. #4
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Do you want to decide this location based on the Building Block category or on a second parameter passed into the function?
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  5. #5
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Christchurch, New Zealand
    Posts
    250
    Thanks
    1
    Thanked 0 Times in 0 Posts
    More than likely on a second parameter passed into the function.

  6. #6
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts
    Try this (untested) code
    Code:
    Function InsertLAAutotext(strAutotext As String, Optional sPos As String)
      Dim strMasterTemplate As Template, atemp As Template
      Templates.LoadBuildingBlocks
      For Each atemp In Templates
        Debug.Print atemp.Name
        If atemp = "Legal Assist Building Blocks.dotx" Then
          Set strMasterTemplate = atemp
          Exit For
        End If
      Next atemp
      Select Case sPos
        Case "Header"
          strMasterTemplate.BuildingBlockEntries(strAutotext).Insert _
               Where:=Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range, RichText:=True
        Case "Footer"
          strMasterTemplate.BuildingBlockEntries(strAutotext).Insert _
               Where:=Selection.Sections(1).Footers(wdHeaderFooterPrimary).Range, RichText:=True
        Case Else
          strMasterTemplate.BuildingBlockEntries(strAutotext).Insert _
               Where:=Selection.Range, RichText:=True
      End Select
    End Function
    Sub WatermarkFileCopy()
      InsertLAAutotext "FileCopy"   'inserts at selection
      InsertLAAutotext "FileCopy", "Header"   'inserts into header
      InsertLAAutotext "FileCopy", "Footer"   'inserts into footer
    End Sub
    Andrew Lockton, Chrysalis Design, Melbourne Australia

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •