Results 1 to 7 of 7
  1. #1
    Star Lounger
    Join Date
    Jun 2002
    Location
    Johannesburg, Gauteng, South Africa
    Posts
    59
    Thanks
    2
    Thanked 0 Times in 0 Posts

    Question Word 2007: Replace logo in header

    Hi all,
    I have a large number of documents containing a logo in the header. I recorded the following code to replace the logo with a new one:

    Code:
    Sub New2011Logo()
    '
    ' New2011Logo Macro
    '
    '
        If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
            ActiveWindow.Panes(2).Close
        End If
        If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
            ActivePane.View.Type = wdOutlineView Then
            ActiveWindow.ActivePane.View.Type = wdPrintView
        End If
        ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
        Selection.HeaderFooter.Shapes("Picture 21").Select
        
        Selection.ShapeRange.Delete
        With ActiveDocument.Shapes.AddPicture(Anchor:=Selection.Range, FileName:= _
            "C:\Documents and Settings\_______\My Documents\____ logo 60mm rgb.jpg", _
            LinkToFile:=False, SaveWithDocument:=True)
            .WrapFormat.Type = 3
            .ZOrder 5
        End With
        Selection.HeaderFooter.Shapes("Picture 22").Select
        Selection.ShapeRange.Width = 170.1
        Selection.ShapeRange.Fill.Visible = msoFalse
        Selection.ShapeRange.Fill.Solid
        Selection.ShapeRange.Fill.Transparency = 0#
        Selection.ShapeRange.Line.Weight = 0.75
        Selection.ShapeRange.Line.DashStyle = msoLineSolid
        Selection.ShapeRange.Line.Style = msoLineSingle
        Selection.ShapeRange.Line.Transparency = 0#
        Selection.ShapeRange.Line.Visible = msoFalse
        Selection.ShapeRange.LockAspectRatio = msoTrue
        Selection.ShapeRange.Rotation = 0#
        Selection.ShapeRange.PictureFormat.Brightness = 0.5
        Selection.ShapeRange.PictureFormat.Contrast = 0.5
        Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic
        Selection.ShapeRange.PictureFormat.CropLeft = 0#
        Selection.ShapeRange.PictureFormat.CropRight = 0#
        Selection.ShapeRange.PictureFormat.CropTop = 0#
        Selection.ShapeRange.PictureFormat.CropBottom = 0#
        Selection.ShapeRange.Left = 87.85
        Selection.ShapeRange.Top = 19.8
        Selection.ShapeRange.RelativeHorizontalPosition = _
            wdRelativeHorizontalPositionPage
        Selection.ShapeRange.RelativeVerticalPosition = _
            wdRelativeVerticalPositionPage
        Selection.ShapeRange.RelativeHorizontalSize = wdRelativeHorizontalSizePage
        Selection.ShapeRange.RelativeVerticalSize = wdRelativeVerticalSizePage
        Selection.ShapeRange.Left = CentimetersToPoints(2.54)
        Selection.ShapeRange.LeftRelative = wdShapePositionRelativeNone
        Selection.ShapeRange.Top = CentimetersToPoints(0)
        Selection.ShapeRange.TopRelative = wdShapePositionRelativeNone
        Selection.ShapeRange.WidthRelative = wdShapeSizeRelativeNone
        Selection.ShapeRange.HeightRelative = wdShapeSizeRelativeNone
        Selection.ShapeRange.LockAnchor = False
        Selection.ShapeRange.LayoutInCell = True
        Selection.ShapeRange.WrapFormat.AllowOverlap = True
        Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
        Selection.ShapeRange.WrapFormat.DistanceTop = CentimetersToPoints(0)
        Selection.ShapeRange.WrapFormat.DistanceBottom = CentimetersToPoints(0)
        Selection.ShapeRange.WrapFormat.DistanceLeft = CentimetersToPoints(0.32)
        Selection.ShapeRange.WrapFormat.DistanceRight = CentimetersToPoints(0.32)
        Selection.ShapeRange.WrapFormat.Type = 3
        Selection.ShapeRange.ZOrder 5
        ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
        Application.Run MacroName:="Normal.SaveBookmark.SaveBookmark"
        ActiveDocument.Close
    End Sub
    Unfortunately the "Picture 21"and thus "Picture 22" as mentioned in the bold parts above are not always the same. How do I ascertain what they should be. There is always only one picture in the header.

    Thanks

    Raymond
    Last edited by jscher2000; 2011-08-19 at 13:26. Reason: Added [code][/code] around code to aid readability.

  2. Get our unique weekly Newsletter with tips and techniques, how to's and critical updates on Windows 7, Windows 8, Windows XP, Firefox, Internet Explorer, Google, etc. Join our 480,000 subscribers!

    Excel 2013: The Missing Manual

    + Get this BONUS — free!

    Get the most of Excel! Learn about new features, basics of creating a new spreadsheet and using the infamous Ribbon in the first chapter of Excel 2013: The Missing Manual - Subscribe and download Chapter 1 for free!

  3. #2
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    You might be able to get away with Shapes(1) to operate on the first shape, unless there are other kinds of shapes in the header.

  4. #3
    Star Lounger
    Join Date
    Jun 2002
    Location
    Johannesburg, Gauteng, South Africa
    Posts
    59
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Thanks Jefferson, but there is also a line in the header

  5. #4
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    Quote Originally Posted by Raymond View Post
    Thanks Jefferson, but there is also a line in the header
    Okay, you could iterate over the shapes collection checking the Type property.

    This code was just a quick test; to use the .Type property in your code, you could iterate over the Selection.HeaderFooter.Shapes collection using an integer counter (for intCounter = 1 to .Count).

    Code:
    Sub SniffShapes()
    Dim shp As Word.Shape
    For Each shp In ActiveDocument.StoryRanges(wdPrimaryHeaderStory).ShapeRange
        If shp.Type = msoPicture Then Debug.Print "Found a picture named " & shp.Name
    Next
    Set shp = Nothing
    End Sub

  6. #5
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    3,899
    Thanks
    0
    Thanked 188 Times in 172 Posts
    Hi Raymond,

    You should be able to do it without knowing the shape name:
    Code:
    Sub New2011Logo()
    Dim Rng As Range, Shp As Shape
    With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary)
      Set Rng = .Shapes(1).Anchor
      .Shapes(1).Delete
      Set Shp = .Shapes.AddPicture(Anchor:=Rng, FileName:= _
            "C:\Documents and Settings\_______\My Documents\____ logo 60mm rgb.jpg", _
            LinkToFile:=False, SaveWithDocument:=True)
      With Shp
        .ZOrder 5
        .Width = 170.1
        .Left = 87.85
        .Top = 19.8
        .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
        .RelativeVerticalPosition = wdRelativeVerticalPositionPage
        .RelativeHorizontalSize = wdRelativeHorizontalSizePage
        .RelativeVerticalSize = wdRelativeVerticalSizePage
        .Left = CentimetersToPoints(2.54)
        .LeftRelative = wdShapePositionRelativeNone
        .Top = CentimetersToPoints(0)
        .TopRelative = wdShapePositionRelativeNone
        .WidthRelative = wdShapeSizeRelativeNone
        .HeightRelative = wdShapeSizeRelativeNone
        .LockAnchor = False
        .LayoutInCell = True
        .LockAspectRatio = msoTrue
        .Rotation = 0#
        With .Fill
          .Visible = msoFalse
          .Solid
          .Transparency = 0#
        End With
        With .Line
          .Weight = 0.75
          .DashStyle = msoLineSolid
          .Style = msoLineSingle
          .Line.Transparency = 0#
          .Visible = msoFalse
        End With
        With .PictureFormat
          .Brightness = 0.5
          .Contrast = 0.5
          .ColorType = msoPictureAutomatic
          .CropLeft = 0#
          .CropRight = 0#
          .CropTop = 0#
          .CropBottom = 0#
        End With
        With .WrapFormat
          .AllowOverlap = True
          .Side = wdWrapBoth
          .DistanceTop = CentimetersToPoints(0)
          .DistanceBottom = CentimetersToPoints(0)
          .DistanceLeft = CentimetersToPoints(0.32)
          .DistanceRight = CentimetersToPoints(0.32)
          .Type = 3
        End With
      End With
    End With
    Application.Run MacroName:="Normal.SaveBookmark.SaveBookmark"
    ActiveDocument.Close
    End Sub
    Note: I've made the code more efficient and deleted some unnecessary code, but I suspect a good deal remains - most of what you have is simply replicating Word's defaults.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  7. #6
    Star Lounger
    Join Date
    Jun 2002
    Location
    Johannesburg, Gauteng, South Africa
    Posts
    59
    Thanks
    2
    Thanked 0 Times in 0 Posts
    Thanks Jeffereson and Paul, have now had to drop that for something else but will try later.

    Raymond

  8. #7
    4 Star Lounger
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    472
    Thanks
    43
    Thanked 0 Times in 0 Posts
    Raymond

    Attached is the code I use to basically do the same when our guys finalise a report. The report has the company logo on the front page and DRAFT watermark in 2 headers(I think I developed this with help from Jefferson)

    Code:
    Sub Final_Report()
    Dim shp As Shape
    On Error Resume Next
    strResponse = MsgBox("Are you sure this is to be the final report?", vbYesNo + _
        vbCritical + vbDefaultButton2, "Final Report")
        If strResponse = 7 Then
            End
        Else
            Application.ScreenUpdating = False
            
            ActiveDocument.Shapes.SelectAll
            Selection.ShapeRange.Delete
                            
            For Each shp In ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Shapes
                If shp.Type = msoTextEffect Then
                    shp.Visible = Not shp.Visible
                End If
            Next shp
        End If
        
            Selection.GoTo What:=wdGoToBookmark, Name:="bmkReportDate"
            Selection.InsertBefore Format(DateAdd("d", 0, Date), "d MMMM yyyy")
     
    End Sub
    Last edited by jscher2000; 2011-09-01 at 17:17. Reason: Added [code][/code] around code to preserve indenting.
    cheers

    Phil Carter

Posting Permissions

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