Macro para incrementar numero y guardar como PDF
Necesito una macro que al darle a imprimir físicamente en papel, me pregunte si incrementar numero de factura y luego me pregunte si generar PDF.
He hecho una compilación de lo que he leído, pero no funciona bien, ya que se crea un bucle en las preguntas.
Me gustaría añadir que si la factura existe con el nombre al generar como pdf que pregunte antes de reescribila, pero de esta parte no tengo nada.
Muchas gracias por la ayuda que me podáis brindar.
Os dejo el código que tengo hasta ahora (el cual funciona mal):
Private Sub Workbook_BeforePrint(Cancel As Boolean)
respuesta = MsgBox("¿Desea autoincrementar?", vbYesNo)
If respuesta = vbYes Then
Range("A18").Value = Range("A18").Value + 1
End If
respuesta = MsgBox("¿Desea guardar como PDF?", vbYesNo)
If respuesta = vbYes Then
nombre = Cells(18, 1).Value
ruta = Cells(1, 1).Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ruta & "factura" & nombre, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
ThisWorkbook.Sabe
End Sub
Te anexo la macro para que imprimas y guarde el pdf. Si ya existe el Pdf, te pregunta si lo quieres sobreescribir o no.
En cualquiera de las preguntas te aparece el botón "Cancelar", si lo presionas se cancela la impresión y también se cancela guardar el archivo como pdf.
En los eventos de thisworkbook, reemplaza tu macro por lo siguiente:
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'Act.Por.Dante Amor
continuar = vbYes
respuesta = MsgBox("¿Desea autoincrementar?", vbYesNoCancel)
Select Case respuesta
Case vbYes
Range("A18").Value = Range("A18").Value + 1
Case vbNo
'No incrementa
Case vbCancel
'se cancela guardar el PDF y la impresión
Cancel = True
Exit Sub
End Select
'
respuesta = MsgBox("¿Desea guardar como PDF?", vbYesNoCancel)
Select Case respuesta
Case vbYes
ruta = Cells(1, 1).Value
nombre = Cells(18, 1).Value & ".pdf"
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
completo = ruta & "factura" & nombre
If Dir(completo) = "" Then
guardarpdf completo
Else
reescribir = MsgBox("La factura ya existe con el nombre: " & vbCr & vbCr & _
completo & vbCr & vbCr & "Desea sobreescribir", _
vbQuestion + vbYesNoCancel, "VALIDA ARCHIVO")
Select Case reescribir
Case vbYes
guardarpdf completo
Case vbNo
'Se cancela el pdf pero continúa la impresión
Case vbCancel
'se cancela guardar el PDF y la impresión
Cancel = True
Exit Sub
End Select
End If
Case vbNo
'Se cancela el pdf pero continúa la impresión
Case vbCancel
'se cancela guardar el PDF y la impresión
Cancel = True
Exit Sub
End Select
ThisWorkbook.Save
End Sub
'
Sub guardarpdf(completo)
'Por.Dante Amor
Application.EnableEvents = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=completo, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Application.EnableEvents = True
End SubSaludos.Dante Amor
Si es lo que necesitas.
2 respuestas más de otros expertos
Para guardar en pdf mira estos ejemplos el primero verifoca si hay una carpeta sino la crea y luego gyarda archivo pdf obteniendo no mbre de variable el segundi envia mail con pdf pero previo gusrda archivo en pdf
http://www.programarexcel.com/2013/05/crea-carpetas-y-guarda-archivo-con.html
http://www.programarexcel.com/2015/03/excel-envia-mail-con-outlook-adjuntando.html
Este ejemplo sencillo de manejo de stock o inventario que otorga num factura al form ventas
http://www.programarexcel.com/2015/01/formulario-ingreso-y-egreso-de-stock.html
Como puedo evitar el imprimir? - Gustavo Villa Tarriba
Buenas Tardes Amigo, ¿como haces para que todas las hojas del libro se guarden en un mismo archivo? - Gustavo Villa Tarriba
En esta línea: ActiveSheet.ExportAsFixedFormat cambia ActiveSheet por ActiveWorkbook - Dante Amor