Consulting

Results 1 to 3 of 3

Thread: Change header Image in Multiple docs without resize

  1. #1

    Change header Image in Multiple docs without resize

    Hi i have gotten close to solving this issue by looking through the forum with the below but it resizes the image randomly. I had been going through the images one by one and clicking replace which left the image at the same size as the original. All help much appreciated. Thanks

    Sub ChangePic()
    Dim strFile As String
    Dim oRng As Range
    Dim oShape As InlineShape
    Const strPath As String = "C:\Users\sample\sample\sample"
    Const strNewImage As String = "C:\Users\sample\Pictures\Pic1.png"
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(strPath) Then
    MsgBox "The document folder '" & strPath & "' is not available."
    GoTo lbl_Exit
    End If
    If Not fso.FileExists(strNewImage) Then
    MsgBox "Unable to locate the image file '" & strNewImage & "'"
    GoTo lbl_Exit
    End If
    strFile = Dir$(strPath & "*.docx*")
    Do While strFile <> ""
    Application.Documents.Open strPath & strFile
    If ActiveDocument.StoryRanges(wdPrimaryHeaderStory).Tables.Count > 0 Then
    Set oRng = ActiveDocument.StoryRanges(wdPrimaryHeaderStory).Tables(1).Range.Cells(1).R ange
    oRng.End = oRng.End - 1
    oRng.Text = ""
    oRng.InlineShapes.AddPicture FileName:=strNewImage
    If ActiveDocument.Saved = False Then ActiveDocument.Save
    End If
    ActiveDocument.Close
    strFile = Dir$
    Loop
    lbl_Exit:
    Exit Sub
    End Sub

  2. #2
    The problem probably relates to table resizing. Try adding

    ActiveDocument.StoryRanges(wdPrimaryHeaderStory).Tables(1).AutoFitBehavior wdAutoFitFixed
    before
    Set oRng = ActiveDocument.StoryRanges(wdPrimaryHeaderStory).Tables(1).Range.Cells(1).Range
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Thank you that has sorted the issue. You've saved me a tonne of work!

Tags for this Thread

Posting Permissions

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