#1
|
|||
|
|||
Macro to Insert Logo in header on 1st page only and bookmark it.
Hi,
Looking for some help please... I'm trying to create a word macro which will insert a logo and address details into the 1st page header & bookmark them. I can't use a template as we generate word documents from a DMS. So far from using macro examples found on the internet I have... Sub AddLogo() Application.ScreenUpdating = False ActiveDocument.PageSetup.DifferentFirstPageHeaderF ooter = True Dim sh As Shape Dim hdr As HeaderFooter Dim rng As Range Dim strPicture As String strPicture = "Z:\Logo1.jpg" For Each hdr In ActiveDocument.Sections(1).Headers Set rng = hdr.Range rng.Collapse wdCollapseEnd Set sh = ActiveDocument.Shapes.AddPicture(strPicture, False, True, 0, 0, , , rng) With sh .Height = CentimetersToPoints(4.94) .Width = CentimetersToPoints(3.58) .LockAspectRatio = True .Left = CentimetersToPoints(13.67) .Top = CentimetersToPoints(-1.23) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone End With Next hdr strPicture = "Z:\Logo2.jpg" For Each hdr In ActiveDocument.Sections(1).Headers Set rng = hdr.Range rng.Collapse wdCollapseEnd Set sh = ActiveDocument.Shapes.AddPicture(strPicture, False, True, 0, 0, , , rng) With sh .Height = CentimetersToPoints(4.29) .Width = CentimetersToPoints(4.84) .LockAspectRatio = True .Left = CentimetersToPoints(7.83) .Top = CentimetersToPoints(-0.27) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone End With Next hdr End Sub This adds a couple of logos into the header but for every page rather than the first page. I'm also not sure how to bookmark the image being added so I can hide it later on in a separate print macro. Thanks for any help. |
#2
|
|||
|
|||
Your line
Quote:
You need to only do it to the first page header: Quote:
|
#3
|
|||
|
|||
Thanks Cosmo, I played around with that a little before posting. Problem is if I change that line to
ActiveDocument.Sections(1).Headers(wdHeaderFooterF irstPage) I get the message Object doesn't support this property or method. |
#4
|
|||
|
|||
Ok so I re wrote the macro to this and it seems to work...
Now I need to be able to bookmark these images being added for removal later if possible? Sub TITLE() Application.ScreenUpdating = False Dim Shp As Shape ActiveDocument.Sections(1).PageSetup.DifferentFirs tPageHeaderFooter = True ActiveDocument.Sections(1).PageSetup.TopMargin = CentimetersToPoints(5) With Selection.Sections(1) Set Shp = .Headers(wdHeaderFooterFirstPage).Shapes.AddPictur e _ (FileName:="Z:\Logo1.jpg", LinkToFile:=False, SaveWithDocument:=True) With Shp .Height = CentimetersToPoints(4.94) .Width = CentimetersToPoints(3.58) .LockAspectRatio = True .Left = CentimetersToPoints(13.67) .Top = CentimetersToPoints(-1.23) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone End With With Selection.Sections(1) Set Shp = .Headers(wdHeaderFooterFirstPage).Shapes.AddPictur e _ (FileName:="Z:\Logo2.jpg", LinkToFile:=False, SaveWithDocument:=True) With Shp .Height = CentimetersToPoints(4.29) .Width = CentimetersToPoints(4.84) .LockAspectRatio = True .Left = CentimetersToPoints(7.83) .Top = CentimetersToPoints(-0.27) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone End With End With Set Shp = Nothing Application.ScreenUpdating = True End Sub Thank you |
#5
|
||||
|
||||
You can't bookmark a shape object. You might bookmark its anchor but, better still, if you name the shape, you can use the name for future reference.
Code:
Sub TITLE() Application.ScreenUpdating = False Dim Shp As Shape With ActiveDocument.Sections(1) With .PageSetup .DifferentFirstPageHeaderFooter = True .TopMargin = CentimetersToPoints(5) End With Set Shp = .Headers(wdHeaderFooterFirstPage).Shapes.AddPicture _ (FileName:="Z:\Logo1.jpg", LinkToFile:=False, SaveWithDocument:=True) With Shp .Height = CentimetersToPoints(4.94) .Width = CentimetersToPoints(3.58) .LockAspectRatio = True .Left = CentimetersToPoints(13.67) .Top = CentimetersToPoints(-1.23) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .Name = "Logo1" End With Set Shp = .Headers(wdHeaderFooterFirstPage).Shapes.AddPicture _ (FileName:="Z:\Logo2.jpg", LinkToFile:=False, SaveWithDocument:=True) With Shp .Height = CentimetersToPoints(4.29) .Width = CentimetersToPoints(4.84) .LockAspectRatio = True .Left = CentimetersToPoints(7.83) .Top = CentimetersToPoints(-0.27) .WrapFormat.AllowOverlap = True .WrapFormat.Side = wdWrapNone .Name = "Logo2" End With End With Set Shp = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
That's great, thank you macropod, will use the # in future.
It turns out then inserting text as a picture file loses quite a bit of quality in the image, so when it prints it looks pretty bad. Instead of inserting a picture using this method is it possible to insert a text box with text in it into the header and position it accordingly? Thanks again. |
#7
|
||||
|
||||
The result you get with images depend on the file format of the image and whether you let Word compress the images. Vector images are uncompressible and retain whatever resolution they're created with. Bitmap images come in a variety of formats (e.g. JPG, TIFF, PNG, GIF) and some of these (e.g. JPG) really aren't suitable for high-resolution text reproduction; allowing Word to compress bitmaps reduces whatever quality they had.
That said, if all you're working with is text, you might consider adding that to a textbox or table cell, which simplifies identification of the range you want to work with.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Thanks again, I think as its just text it might be better to use textboxes.
I have managed to get a textbox added into the header and put in some 'test' text, how do I set the textbox to have no outline and set the font etc for the text? Code:
With Selection.Sections(1) Set Shp = .Headers(wdHeaderFooterFirstPage).Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _ Left:=50, Top:=50, Width:=100, Height:=100) With Shp .LockAspectRatio = True .Height = CentimetersToPoints(3.53) .Width = CentimetersToPoints(4.68) .Left = CentimetersToPoints(8.74) .Top = CentimetersToPoints(-0.96) .WrapFormat.Side = wdWrapNone .WrapFormat.Type = wdWrapBehind .Name = "CCTextBox" .TextFrame.TextRange.Text = "Test" End With End With Code:
ActiveDocument.Sections(1).Headers(wdHeaderFooterFirstPage).Shapes("CCLogo").Visible = msoTrue |
#9
|
||||
|
||||
You can hide the outline with:
.Line.Visible = False (the macro recorder could show you that). As for hiding the content a print time, you can do that without a macro. See, for example Show or hide instructions & graphics at print time in my Microsoft Word Date Calculation Tutorial, available at: http://windowssecrets.com/forums/sho...ation-Tutorial or: http://www.gmayor.com/downloads.htm#Third_party
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#10
|
|||
|
|||
Thanks again for your help.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Macro to insert Landscape page | Catty | Word VBA | 1 | 05-05-2014 03:42 AM |
Open header to insert text into bookmark | Amapola188 | Word VBA | 3 | 07-12-2012 05:16 PM |
Macro to insert new page... | samanthaj | Word | 17 | 01-31-2012 01:53 PM |
Macro to get first letter of a page in the header | faramir | Word VBA | 4 | 11-16-2011 05:43 AM |
How to print header logo only in 1st page | Shafraz Khahir | Word | 1 | 11-29-2010 11:52 AM |