Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    Nov 2004
    Location
    New Castle, Delaware, USA
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Pasting Shapes into Headers (97 / 2000)

    I'm working on a project to add a letterhead to a series of templates. The letterhead was designed by the graphics department in our (German) home office, and I need to apply it to my (US) company's existing templates. The letterhead resides in an otherwise empty template. It is made from a series of Autoshapes and text boxes. The tricky part is that there are two letterheads needed: One for the first page, and a different one for all subsequent pages.

    My goal is to write a macro where I can open each tempate in the Workgroup Templates location, run my macro, and apply the graphics to each of the templates in that location. Many of these templates are a single page.

    For several days, I've been working on the subroutine below to loop through the headers of the letterhead source document ("docLH") and apply it to the Active Document ("docCurr"), This is the latest in a series of iterations I've gone through. The best I've been able to achieve is that I get both of the headers from docLH in the first page header of docCurr. Any suggestions?

    For extra credit points: Is there a cleaner way to duplicate a series of shapes between documents other than using Selection.Copy and .Paste?

    Thanks,

    Chris in Delaware

    <img src=/w3timages/blackline.gif width=33% height=2>

    <pre>Sub AddLH()
    Dim i As Integer
    Dim docLH As Document, docCurr As Document
    Dim rangeHead As Range
    Dim lngHeads(2) As Long, lngViews(2) As Long

    lngHeads(1) = wdHeaderFooterPrimary
    lngHeads(2) = wdHeaderFooterFirstPage

    lngViews(1) = wdSeekPrimaryHeader
    lngViews(2) = wdSeekFirstPageHeader

    Set docLH = Documents.Open(cLHPath & cLHFile)
    Set docCurr = ActiveDocument

    'Make sure the DifferentFirstPageHeaderFooter property is set.
    With docCurr.Sections(1).PageSetup
    If Not .DifferentFirstPageHeaderFooter _
    Then .DifferentFirstPageHeaderFooter = True
    End With

    ' subroutine to make sure document is in a view to show header,
    ' then set SeekView = wdSeekCurrentPageHeader
    Call viewHeader(docCurr)
    Call viewHeader(docLH)

    For i = 1 To 2
    Set rangeHead = docLH.Sections(1).Headers(lngHeads(i)).Range
    rangeHead.ShapeRange.Select
    Selection.Copy
    DoEvents
    docCurr.Windows(1).View.SeekView = lngViews(i)
    docCurr.Sections(1).Headers(lngHeads(i)).Range.Pas te
    Next

    docCurr.Windows(1).ActivePane.View.SeekView = wdSeekMainDocument
    docLH.Windows(1).ActivePane.View.SeekView = wdSeekMainDocument

    docLH.Close SaveChanges:=wdDoNotSaveChanges

    End Sub
    </pre>


  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts

    Re: Pasting Shapes into Headers (97 / 2000)

    This is happening because the Shapes Range doesn't care which header it is in - they are all lumped in together.

    This bug took me ages to work out when I was trying to develop a smart macro to create watermarks in a document across multiple sections. This thread discusses the problem.

    If you can use inline graphics instead then you will avoid all the problems and the file sizes will be smaller too.
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. #3
    Plutonium Lounger
    Join Date
    Nov 2001
    Posts
    10,550
    Thanks
    0
    Thanked 7 Times in 7 Posts

    Re: Pasting Shapes into Headers (97 / 2000)

    You will find another example showing how to identify shapes in a particular header/footer in <post#=271588>post 271588</post#>

    StuartR

Posting Permissions

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