Gracias por tu respuesta, pero lo intente pero sigue imprimiendo una parte luego sigue con la otra, no intercala el formulario con el PDF. te adjunto las macros :
Macro 1, copia el valor de celda F de la hoja 2 y lo pega en la celda F3 de la hoja 1, al colocar un valor en la celda F3 de la hoja 1, ejecuta otra macros que extrae información y luego imprime. luego baja a la otra celda de la hoja 2 columna F y realiza lo mismo, hasta a encontrar una celda vacia.
Sub ProcesaNomina()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
'
For i = 2 To h2.Range("F" & Rows.Count).End(xlUp).Row
h1.[F3] = h2.Cells(i, "F")
Next
End Sub
Macro 2 relaciona el numero del formulario que se encuentra en la columna F de la hoja 2 con el numero de factura de la columna G de la misma hoja, luego buscar el numero de la factura en una carpeta en donde se encuentra el pdf y lo imprime. las facturas que no encontró en la carpeta me crea un informe en la hoja 3.
Sub ImprimirPDFs()
Application.EnableCancelKey = xlDisabled
Dim i As Integer, j As Integer, pid As Long, hnd As Long, ruta As String, arch As String
Set h1 = Sheets("Hoja2")
Set h2 = Sheets("Hoja3")
h2.Cells.Clear
j = 2
n = 1
On Error Resume Next
u = h1.Range("G" & Rows.Count).End(xlUp).Row
Application.StatusBar = False
For i = 2 To u
Application.StatusBar = "Imprimiendo " & n & " de " & u
n = n + 1
ruta = "Z:\Contabilidad_Fuller\Babu_Master\Intercompany Invoices\July 2016 Payments\" & h1.Cells(i, "A")
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
arch = h1.Cells(i, "G")
arch1 = h1.Cells(i, "A")
arch2 = h1.Cells(i, "F")
If UCase(Right(arch, 4)) <> ".PDF" Then arch = arch & ".pdf"
If Dir(ruta & arch) <> "" Then
pid = Shell("C:\Program Files (x86)\Adobe\Reader 8.0\Reader\AcroRd32.exe /p /h """ & ruta & arch & """", vbMinimizedNoFocus)
DoEvents
Application.Wait Now + TimeValue("00:00:03")
DoEvents
hnd = OpenProcess(PROCESS_TERMINATE, True, pid)
DoEvents
TerminateProcess hnd, 0
DoEvents
Application.Wait Now + TimeValue("00:00:01")
Else
h2.Cells(j, "A") = arch1
h2.Cells(j, "B") = arch2
h2.Cells(j, "C") = arch
j = j + 1
End If
Next
Application.StatusBar = False
Call titulos
MsgBox "PDF impresos, Hoja 3 indica archivos no encontrados"
End Sub
lo que necesito, es ejecutar la macro1 y macros 2, pero intercaldas.
que imprima el formulario luego el PDF y después baje a la siguiente celda de la hoja2 y vuelva a realizar lo mismo hasta no encontrar mas datos.
Espero me puedas ayudar