Como crear botón con código que me permita generar varios recibos de pago y convertirlos de excel a pdf
Lo que necesito es que el botón guardar recibo de pdf me permita guardarlos de acuerdo a un rango de trabajadores y no de uno en uno solamente, como esta el código actualmente,
Ver ese boton
Private Sub CommandButton1_Click()
En la hoja
'"recibo empleadosFijos y direct."
1 Respuesta
Respuesta de Dante Amor
1
H o l a : En un correo nuevo, envíame el archivo, dentro del archivo, me explicas con comentarios, colores o lo que creas conveniente para explicarme lo que necesitas.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “roxanna martinez” y el título de esta pregunta.
H o l a :
Avísame cualquier duda o detalle que encuentres en la macro y con gusto te ayudo a actualizarla.
Te anexo la macro
Private Sub CommandButton5_Click()
'Por experto excel dante
Application.ScreenUpdating = False
Set h2 = Sheets("Carga")
Set h3 = Sheets("recibo empleadosFijos y direct.")
Set h4 = Sheets("Formato")
'
fila = h3.[L3]
ruta = "C:\Documents and Settings\Administrador\Escritorio\Recibos de Pago\Empleados Fijos y Personal Directivo\"
'ruta = ThisWorkbook.Path & "\"
Do While h2.Cells(fila, "B") <> "" And h3.[g4] >= h3.[D2] And h3.[g4] < h3.[D3]
m = h3.[D2]
n = h3.[D3]
For i = m To n
Next
h4.Rows.Hidden = False
h4.Range("A:I").Clear
h4.DrawingObjects.Delete
h3.[g4] = h2.Cells(fila, "A")
'Aqui guarda recibo1 a PDF
APdf h3
'copia recibo 1
h3.Range("A7:I" & h3.Range("C" & Rows.Count).End(xlUp).Row).Copy
h4.Range("A" & 1).PasteSpecial Paste:=xlValues
h4.Range("A" & 1).PasteSpecial Paste:=xlFormats
h4.Range("A" & 2).PasteSpecial Paste:=xlPasteColumnWidths
CopiarImagen2 h3, h4, 3
'
If h2.Cells(fila + 1, "B") <> "" Then
h3.[g4] = h2.Cells(fila + 1, "A")
'Aqui guarda recibo2 a PDF
aPdf h3
'copia recibo 2
h3.Range("A7:I" & h3.Range("C" & Rows.Count).End(xlUp).Row).Copy
u3 = h4.Range("C" & Rows.Count).End(xlUp).Row + 4
h4.Range("A" & u3).PasteSpecial Paste:=xlValues
h4.Range("A" & u3).PasteSpecial Paste:=xlFormats
End If
'
u4 = h4.Range("C" & Rows.Count).End(xlUp).Row
For i = 15 To u4
If h4.Cells(i, "H") = 1 And h4.Cells(i, "I") = 1 Then
h4.Rows(i).Hidden = True
End If
Next
CopiarImagen2 h3, h4, u3 + 2
'Aqui imprime
With h4.PageSetup
.PrintArea = "A1:G" & h4.Range("C" & Rows.Count).End(xlUp).Row
.Orientation = xlPortrait
.FitToPagesWide = 1
.FitToPagesTall = 1
.LeftMargin = Application.InchesToPoints(0.590551181102362)
.RightMargin = Application.InchesToPoints(0.590551181102362)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
End With
h4.PrintOut Copies:=1, Collate:=True
'
fila = fila + 2
Loop
MsgBox "Impresión realizada y el Respaldo del recibo fue generado con exito", vbInformation, "IMPRIMIR RECIBO"
End Sub
Sub CopiarImagen2(h3, h4, u3)
'copiar imagenes en el recibo
h3.Shapes("Imagen 1").Copy
h4.Select
h4.Paste
Selection.Top = h4.Range("B" & u3).Top
Selection.Left = h4.Range("B" & u3).Left + 20
h3.Shapes("Imagen 2").Copy
h4.Paste
Selection.Top = h4.Range("G" & u3).Top
Selection.Left = h4.Range("G" & u3).Left + 5
End Sub
Sub aPdf(h3)
'Aqui guarda a PDF
ruta = "C:\Documents and Settings\Administrador\Escritorio\Recibos de Pago\Empleados Fijos y Personal Directivo\"
h3.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & h3.Range("C17") & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, From:=2, To:=2, OpenAfterPublish:=False
End Sub
