Generar PDF multipáginas desde Excel con foto

H o l a:

1. Revisa que las fotos, logos, etc tenga en su propiedad marcada la opción "mover y cambiar tamaño con celdas"

2. Revisa en las opciones de excel, Avanzadas, esté activa la casilla de Cortar, copiar y ordenar objetos junto con las celdas:

Prueba nuevamente la macro.

Si lo anterior no resuelve el problema, envíame tu archivo con las fotos y logos; y con la macro, para probar.

Recuerda poner en el asunto tu nombre de usuario.

':)
':)

Hola Dante

Ayer te mande el fichero. 

Un saludo, Ruben.

H o l a:

Te anexo la macro actualizada

Private Sub CommandButton1_Click()
' SE GENERA EL INFORME PDF DE LAS ILLIGS
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    Application.StatusBar = False
    '
    'If MsgBox("TARDA 1 MINUTO EN GENERARSE ESTE INFORME, ¿ESTÁS SEGURO QUE QUIERES CREARLO?," & vbCr & "PULSA ACEPTAR PARA CONTINUAR", vbOKCancel + vbInformation, "Imprimir plantilla") = vbCancel Then Exit Sub
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("ILLIG")
    Set h2 = l1.Sheets("IMPRIMIR_ILLIG(RICOH)")
    Set l2 = Workbooks.Add
    Ruta = "C:\Users\RUBEN\Desktop\"
    'Ruta = "C:\trabajo\"
    archxls = "FICHERO_TEMPORAL_ILLIG.xls"
    archpdf = "FICHAS_ILLIG.pdf"
    '
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 4 To u
        Application.StatusBar = "PROCESANDO EL REGISTRO: " & i & " de " & u
        h1.Rows(i).Copy h2.Rows(3)
        h2.Copy after:=l1.Sheets(l1.Sheets.Count)
        Set h4 = ActiveSheet
        h4.Range("A6:K61").Copy
        h4.[A6].PasteSpecial Paste:=xlValues
        l2.Sheets.Add after:=l2.Sheets(l2.Sheets.Count)
        Set h3 = l2.ActiveSheet
        h4.Range("A6:K61").Copy h3.[A1]
        h4.Range("A6:K61").Copy
        h3.[A1].PasteSpecial Paste:=xlPasteColumnWidths
        '
        h3.PageSetup.PrintArea = "A1:K61"
        '
        res h3
        h4.Delete
    Next
    l2.SaveAs Filename:=Ruta & archxls, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    '
    l2.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Ruta & archpdf, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    l2.Close
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "ARCHIVO PDF CREADO"
End Sub

':)
':)

Hola Dante

Respecto a la marca de agua me refería a la imagen que te adjunto y no al texto que pone "Página 1". Solo me sale cuando hago una vista preliminar.

Si se puede hacer que pase la marca de agua también a PDF pues bien y si es complicado o no se puede entonces no me importaría en absoluto. Gracias

Un saludo, Rubén

Te anexo la macro actulaizada

Private Sub CommandButton1_Click()
' SE GENERA EL INFORME PDF DE LAS ILLIGS
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    Application.StatusBar = False
    '
    'If MsgBox("TARDA 1 MINUTO EN GENERARSE ESTE INFORME, ¿ESTÁS SEGURO QUE QUIERES CREARLO?," & vbCr & "PULSA ACEPTAR PARA CONTINUAR", vbOKCancel + vbInformation, "Imprimir plantilla") = vbCancel Then Exit Sub
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("ILLIG")
    Set h2 = l1.Sheets("IMPRIMIR_ILLIG(RICOH)")
    Set l2 = Workbooks.Add
    Ruta = "C:\Users\RUBEN\Desktop\"
    Ruta = "C:\trabajo\"
    archxls = "FICHERO_TEMPORAL_ILLIG.xls"
    archpdf = "FICHAS_ILLIG.pdf"
    '
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 4 To u
        Application.StatusBar = "PROCESANDO EL REGISTRO: " & i & " de " & u
        h1.Rows(i).Copy h2.Rows(3)
        h2.Copy after:=l1.Sheets(l1.Sheets.Count)
        Set h4 = ActiveSheet
        h4.Range("A6:K61").Copy
        h4.[A6].PasteSpecial Paste:=xlValues
        '
        h4.Rows("1:5").Delete
        h4.Copy after:=l2.Sheets(l2.Sheets.Count)
        'l2.Sheets.Add after:=l2.Sheets(l2.Sheets.Count)
        Set h3 = l2.ActiveSheet
        'h4.Range("A6:K61").Copy h3.[A1]
        'h4.Range("A6:K61").Copy
        'h3.[A1].PasteSpecial Paste:=xlPasteColumnWidths
        '
        h3.PageSetup.PrintArea = "A1:K61"
        '
        res h3
        h4.Delete
    Next
    l2.SaveAs Filename:=Ruta & archxls, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    '
    l2.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Ruta & archpdf, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    l2.Close
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox "ARCHIVO PDF CREADO"
End Sub
Sub res(h3)
    With h3.PageSetup
        .LeftHeader = ""
        '.CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .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 = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub

':)
':)