Macro para imprimir un registro en un formato
Dante
Hace algún tiempo me ayudaste con un macro para imprimir una serie de registros en una forma, ahora requiero que además de eso, se pueda imprimir un sólo registro o una serie de ellos, es decir, imprimir sólo el registro 3 o los registros 2,4 y 7 por ejemplo.
1 Respuesta
Respuesta de Dante Amor
1
Sería poner cualquier celda para escribir los números de recibos
Te anexo las macros actualizadas
Sub LlenarFormato1()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = Sheets("NOMINA")
Set h2 = Sheets("FORMATO")
'
If h1.Range("E1") = "" Then
For i = 6 To h1.Range("A" & Rows.Count).End(xlUp).Row Step 2
Call Imprimir(h1, h2, i, i + 1)
Next
Else
num = h1.Range("E1")
ctrl = Split(num, ",")
i = ""
j = ""
For n = LBound(ctrl) To UBound(ctrl) Step 2
u = h1.Range("A" & Rows.Count).End(xlUp).Row
valor1 = Trim(ctrl(n))
On Error Resume Next
valor2 = ""
valor2 = Trim(ctrl(n + 1))
On Error GoTo 0
Set b = h1.Range("A6:A" & u).Find(valor1, lookat:=xlWhole)
If Not b Is Nothing Then
i = b.Row
End If
If valor2 <> "" Then
Set b = h1.Range("A6:A" & u).Find(valor2, lookat:=xlWhole)
If Not b Is Nothing Then
j = b.Row
End If
Else
j = 0
End If
If i <> "" And j <> "" Then
Call Imprimir(h1, h2, i, j)
End If
Next
End If
h1.Select
Application.ScreenUpdating = True
MsgBox "Fin"
End Sub
'
Sub Imprimir(h1, h2, i, j)
'Por.Dante Amor
h2.Copy after:=Sheets(Sheets.Count)
Set h3 = ActiveSheet
h3.Range("B2") = h1.Range("B" & i)
h3.Range("G2") = h1.Range("C" & i)
h3.Range("I2") = h1.Range("A" & i)
h3.Range("B4") = h1.Range("D" & i)
h3.Range("D4") = h1.Range("B2") 'celda fija
h3.Range("G4") = h1.Range("B1") 'celda fija
h3.Range("H4") = h1.Range("E" & i)
h3.Range("D8") = h1.Range("AH" & i)
h3.Range("D9") = h1.Range("AI" & i)
h3.Range("D10") = h1.Range("AJ" & i)
h3.Range("D11") = h1.Range("AK" & i)
h3.Range("E8") = h1.Range("AL" & i)
h3.Range("E9") = h1.Range("AM" & i)
h3.Range("E10") = h1.Range("AN" & i)
h3.Range("E11") = h1.Range("AO" & i)
h3.Range("E12") = h1.Range("AP" & i)
h3.Range("E13") = h1.Range("AQ" & i)
h3.Range("E14") = h1.Range("AR" & i)
h3.Range("E15") = h1.Range("AS" & i)
h3.Range("E16") = h1.Range("AT" & i)
h3.Range("E17") = h1.Range("AU" & i)
h3.Range("E18") = h1.Range("AV" & i)
h3.Range("I8") = h1.Range("AX" & i)
h3.Range("I9") = h1.Range("AY" & i)
h3.Range("I10") = h1.Range("AZ" & i)
h3.Range("I11") = h1.Range("BA" & i)
h3.Range("I12") = h1.Range("BB" & i)
h3.Range("I13") = h1.Range("BC" & i)
h3.Range("I14") = h1.Range("BD" & i)
h3.Range("I15") = h1.Range("BE" & i)
'
If j > 0 Then
h3.Range("B26") = h1.Range("B" & j)
h3.Range("G26") = h1.Range("C" & j)
h3.Range("I26") = h1.Range("A" & j)
h3.Range("B28") = h1.Range("D" & j)
h3.Range("D28") = h1.Range("B2")
h3.Range("G28") = h1.Range("B1")
h3.Range("H28") = h1.Range("E" & j)
h3.Range("D32") = h1.Range("AH" & j)
h3.Range("D33") = h1.Range("AI" & j)
h3.Range("D34") = h1.Range("AJ" & j)
h3.Range("D35") = h1.Range("AK" & j)
h3.Range("E32") = h1.Range("AL" & j)
h3.Range("E33") = h1.Range("AM" & j)
h3.Range("E34") = h1.Range("AN" & j)
h3.Range("E35") = h1.Range("AO" & j)
h3.Range("E36") = h1.Range("AP" & j)
h3.Range("E37") = h1.Range("AQ" & j)
h3.Range("E38") = h1.Range("AR" & j)
h3.Range("E39") = h1.Range("AS" & j)
h3.Range("E40") = h1.Range("AT" & j)
h3.Range("E41") = h1.Range("AU" & j)
h3.Range("E42") = h1.Range("AV" & j)
h3.Range("I32") = h1.Range("AX" & j)
h3.Range("I33") = h1.Range("AY" & j)
h3.Range("I34") = h1.Range("AZ" & j)
h3.Range("I35") = h1.Range("BA" & j)
h3.Range("I36") = h1.Range("BB" & j)
h3.Range("I37") = h1.Range("BC" & j)
h3.Range("I38") = h1.Range("BD" & j)
h3.Range("I39") = h1.Range("BE" & j)
End If
'
h3.PrintOut
h3.Delete
End Sub'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
