Блог

Я хочу установить другой верхний и нижний колонтитулы с помощью VBA для первой страницы листа Excel, который должен быть напечатан. Правый заголовок должен содержать изображение, а левый заголовок — другое изображение. Они должны отображаться только на первой странице.

Я пробовал приведенный ниже код, но почему-то .Объект Firstpage приводит меня к сообщению об ошибке.

 Sub AddFooterHeaderImage()
    
Dim ImagePath As String
Dim ImagePath2 As String
Dim Validation As String
Dim ws As Worksheet
Dim excludeSheets As String


  ImagePath = "C:PicturesPicture1.png"
  ImagePath2 = "C:PicturesPicture2.png"
  
            
excludeSheets = "|Instructions|VCS|Import|"      
Application.ScreenUpdating = False

With ThisWorkbook
For Each ws In .Worksheets

If InStr(excludeSheets, "|" amp; ws.Name amp; "|") = 0 Then
  
    With ws.PageSetup
    .DifferentFirstPageHeaderFooter = True
    .FirstPage.RightHeaderPicture.Filename = ImagePath 
    .FirstPage.RightHeader = "amp;G"
    .FirstPage.LeftHeaderPicture.Filename = ImagePath2
    .FirstPage.LeftHeader = "amp;G"
    
    
    ws.DisplayPageBreaks = False
    End With

End If
Next ws
End With
Sheets("Instructions").Select

OutPut = MsgBox("Headers amp; Footers added", vbInformation, "Information")
End Sub
 

Я изменил код, как показано ниже, и он работает.

 Sub AddFooterHeaderImage()
'PURPOSE: Insert Image File into Spreadsheet Header or Footer on every selected worksheet


Dim ImagePath As String
Dim ImagePath2 As String
Dim Validation As String
Dim ws As Worksheet
Dim excludeSheets As String


'Where is Image Located?
  ImagePath = "S:desktopxxxx.png"
  ImagePath2 = "S:desktopxx.png"
  
'Does the Image File Exist?
  On Error Resume Next
    Validation = Dir(ImagePath)
    Validation = Dir(ImagePath2)
  On Error GoTo 0

  If Validation = "" Then
    MsgBox "Could not locate the image file located here: " amp; ImagePath
    Exit Sub
  End If
      
'Add Image To Each Active Sheet
excludeSheets = "|sheetA|SheetB|SheetC|"        'The sheet names to exclude delimited by "|"
Application.ScreenUpdating = False

With ThisWorkbook

For Each ws In .Worksheets

If InStr(excludeSheets, "|" amp; ws.Name amp; "|") = 0 Then
  
    ws.PageSetup.FirstPage.LeftHeader.Picture.Filename = _
        "S:desktopxxxx.png"
    
    ws.PageSetup.FirstPage.RightHeader.Picture.Filename = _
        "S:desktopxx.png"
        Application.PrintCommunication = False
    With ws.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = True
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = "amp;G"
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = "amp;G"
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    ws.PageSetup.CenterFooter = "add free text here"
   
    
    'Ensure Pagebreaks don't show
    ws.DisplayPageBreaks = False
        
 
    
End If

Next ws
End With
Sheets("SheetA").Select

OutPut = MsgBox("Headers amp; Footers added", vbInformation, "Information")
End Sub