Hacer que botones de macros funcionen con alguna condición previa.
Soy muy novato en este tema pero por cosas de la vida teminé en esto.
Todo comenzó con crear un modelo de factura, pero luego me han encargado dos botones que me están estresando la existencia.
Es un modelo de factura y necesito dos botones "CREAR PDF" que guarda la factura en formato pdf y la abre y "NUEVA FACTURA" que limpia los campos y aumenta en uno el contador de factura.
PEEEEERO, "CREAR PDF" solo debe estar activo si hay dos celdas llenadas como mínimo (nombre y monto total) así evitamos generar pdf en blanco. Además la ruta en donde se guarda y el nombre del archivo se escribirán en dos celda de la segunda hoja del excel.
"NUEVA FACTURA" solo debe estar activo después de haber usado el botón "CREAR FACTURA" así se evita borrar por error lo avanzado o presionarlo varias veces y aumentar el contador de facturas exageradamente por error.
Adjunto mis códigos a ver si me pueden salvar, gracias.
CREAR PDf:
Sub GenerarPDF()
'
' GenerarPDF Macro
' Genera un PDF de la factura creada.
'
'
Dim NombreCliente As String
Dim MontoTotal As Double
NombreCliente = Cells(10, 3).Value
MontoTotal = Cells(36, 11).Value
If NombreCliente <> "" And MontoTotal <> 0 Then
Range("A1:L37").Select
ActiveWindow.SmallScroll Down:=-21
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\4ser\Desktop\TRABAJO\PDF FACTURA 01.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Range("C10:L11").Select
End If
End SubNUEVA FACTURA:
Sub NuevoDocumento()
Dim NumeroDocumento As Long
Dim NombreCliente As String
Dim MontoTotal As Double
NombreCliente = Cells(10, 3).Value
MontoTotal = Cells(36, 11).Value
If NombreCliente <> "" And MontoTotal <> 0 Then
NumeroDocumento = Worksheets("INSTRUCCIONES").Cells(31, 3).Value + 1
Worksheets("INSTRUCCIONES").Cells(31, 3) = NumeroDocumento
Cells(6, 7) = NumeroDocumento
End If
Range("A19:A34").Select
Selection.ClearContents
Range("B19:I34").Select
Selection.ClearContents
Range("J19:J34").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-9
Range("C10:L11").Select
Selection.ClearContents
End SubA veces hasta me sale error tipo "13" cuando ejecuto varias veces el botón.
Te anexo las macros actualizadas. En las macros puse unos comentarios explicando el funcionamiento.
Sub GenerarPDF()
' Act Por Dante Amor
' GenerarPDF Macro
' Genera un PDF de la factura creada.
'
'
Dim NombreCliente As String
Dim MontoTotal As Double
'
Set h1 = ActiveSheet
Set h2 = Sheets("INSTRUCCIONES") 'nombre de la segunda hoja
'
NombreCliente = h1.Cells(10, 3).Value
MontoTotal = h1.Cells(36, 11).Value
ruta = h2.Range("A2") 'nombre de la ruta
arch = h2.Range("A3") 'nombre de archivo
'
If NombreCliente = "" Then
MsgBox "Falta el nombre de cliente"
Exit Sub
End If
If MontoTotal = 0 Then
MsgBox "Falta el monto total"
Exit Sub
End If
If ruta = "" Then
MsgBox "Falta la ruta"
Exit Sub
End If
If arch = "" Then
MsgBox "Falta el nombre de archivo"
Exit Sub
End If
'
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
If LCase(Right(arch, 4)) <> ".pdf" Then arch = arch & ".pdf"
h1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & arch, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
h2.Range("Z1") = "" 'se pone en blanco la celda Z1 para que puedan limpiar la factura
End SubPara limpiar la factura:
Sub NuevoDocumento()
Dim NumeroDocumento As Long
Dim NombreCliente As String
Dim MontoTotal As Double
'
Set h2 = Worksheets("INSTRUCCIONES")
If h2.Range("Z1") <> "" Then
MsgBox "No han creado la factura"
Exit Sub
End If
'
NombreCliente = Cells(10, 3).Value
MontoTotal = Cells(36, 11).Value
If NombreCliente <> "" And MontoTotal <> 0 Then
NumeroDocumento = h2.Cells(31, 3).Value + 1
h2.Cells(31, 3) = NumeroDocumento
Cells(6, 7) = NumeroDocumento
h2.Range("Z1") = "1" 'se pone un valor en la Z1 para que no puedan incrementar la factura
'hasta que creen la factura
End If
Range("A19:A34").ClearContents
Range("B19:I34").ClearContents
Range("J19:J34").ClearContents
Range("C10:L11").ClearContents
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
