crear pdf de cada registro de mi listado conbinado

1 post / 0 nuevos
tetorin
Imagen de tetorin
Offline
última acción: Hace 4 semanas 1 día
Nivel 1 - 200 puntosNivel 2 - 500 puntosNivel 3 - 1000 puntosNivel 4 - 2000 puntos
alta: 26/05/2011 - 02:57
Puntos: 3077
crear pdf de cada registro de mi listado conbinado

Buenas tardes atodos, saludos

nesesito de su ayuda, espero me puedan ayudar

como puedo crear varios pdf segun lista desplegable

tengo este codigo pero siempre se cierra el Excel anexo el mensaje que me arroja el Excel . espero me puedan ayudar o compartir otro codigo

anexo micodigo...

Sub criarArquivoDeEnvio()

' criarArquivoDeEnvio Macro

  Application.Calculation = xlAutomatic

    Application.ScreenUpdating = False

    Application.DisplayAlerts = False

    

    Workbooks.Add

    ChDir ThisWorkbook.Path

    ActiveWorkbook.SaveAs Filename:= _

        ThisWorkbook.Path & "\Delete-Me.xlsx" _

        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

        

    Windows("GMB - Daily Tracking..xlsm").Activate

    Sheets("Competitors").Visible = True

    Sheets("Competitors").Select

 

 

    Dim i As Long

    Dim j As Long

    

    i = 2

    j = 15

        

    For i = 2 To j

    Windows("GMB - Daily Tracking..xlsm").Activate

    Sheets("Competitors").Activate

    Range("A" & i).Select

    Selection.Copy

    Sheets("Daily Tracking").Activate

    Range("C4:E4").Select

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _

        SkipBlanks:=False, Transpose:=False

        

        

    Call moveOrCopy

    

    

    Next i

    

    

    Windows("GMB - Daily Tracking..xlsm").Activate

    Sheets("Competitors").Select

    ActiveWindow.SelectedSheets.Visible = False

    Sheets("Daily Tracking").Select

    

    

    Windows("Delete-Me.xlsx").Activate

    ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

        ThisWorkbook.Path & "\BRA - Daily Tracking.pdf" _

        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _

        :=False, OpenAfterPublish:=False

    ActiveWindow.Close

        

        

    Application.ScreenUpdating = True

    Application.DisplayAlerts = True

End Sub

Sub moveOrCopy()

'

' moveOrCopy Macro

'

    Windows("GMB - Daily Tracking..xlsm").Activate

    Sheets("Daily Tracking").Select

    Sheets("Daily Tracking").Copy Before:=Workbooks( _

        "Delete-Me.xlsx").Sheets(1)

    ActiveWorkbook.BreakLink Name:= _

        ThisWorkbook.Path & "\GMB - Daily Tracking..xlsm" _

        , Type:=xlExcelLinks

 

End Sub

 

 

 

 

AdjuntoTamaño
Image icon mensaje_de_error.png9.07 KB

Etiquetas: