Macro para grabar información y guardar como PDF

Tengo un macro que me permite grabar la información de la factura en una base de datos y enseguida grabarla en un directorio asignado como extension XLSX, quisiera poder grabarlo como PDF

Las instrucciones son las siguientes:

Public Sub FacturarProductos1()
Dim Factura As Single
Dim Prefijo As String
Dim Fecha As Date
Dim Ano As Single
Dim Mes As Single
Dim Dia As Single
Dim Usuario As String
Dim F As Single
Dim FF As Single
Dim Productos As Single
Dim NombreArchivo As String
Dim ruta As String
Dim RutaFactura As String
Dim Codigo As Single
Dim CodigoHoja As String
Dim Producto As String
Dim Cantidad As Single
Dim PrecioUnidad As Double
Dim img As Shape
Dim NombreHojaFac As String
Dim NombreHojaFacAux As String

Application.ScreenUpdating = False

Fact = MsgBox("Estas seguro de generar la factura?", vbYesNo, "Generar Factura")
If Fact = vbYes Then
'' Hoja12.Select
'' If Range("D9").Value = "" Then
'' MsgBox "Actualmente no hay un Usuario autenticado para generar la factura.", vbCritical, "Autenticaci—n Usuario"
'' Range("D9").Select
'' Exit Sub
'' End If
''
'' Usuario = Range("D9").Value
If Range("D28").Value = "" Then
MsgBox "No hay productos para facturar " & Usuario & ".", vbExclamation, "Generar Facturar"
Range("D28").Select
Exit Sub
End If
Range("D27").End(xlDown).Select
F = ActiveCell.Row
Productos = ActiveCell.Row - 27
Factura = Range("E12").Value
Prefijo = Range("H12").Value
Fecha = Range("J12").Value
Ano = Range("A2").Value
Mes = Range("A3").Value
Dia = Range("A4").Value
Range("J12").Select
ActiveCell.FormulaR1C1 = "=NOW()"
NombreArchivo = Range("A1").Value
Hoja13.Visible = xlSheetVisible
ruta = Hoja13.Cells(4, 2).Text
RutaFactura = ruta & "\" & NombreArchivo & ".xlsx"
Const ATTR_DIRECTORY = 16
If Dir$(ruta, ATTR_DIRECTORY) = "" Then
MsgBox ("El directorio para guardar las Facturas no existe")
'Hoja13.Visible = xlSheetHidden
Exit Sub
End If
'Hoja13.Visible = xlSheetHidden
Hoja10.Visible = xlSheetVisible
NombreHojaFac = Hoja12.Name
Sheets(NombreHojaFac).Select
Sheets(NombreHojaFac).Copy
Sheets(NombreHojaFac).Select
Range("E12:J12").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For Each img In ActiveSheet.Shapes
If img.Type <> 13 Then img.Delete
Next
Rows("1:10").Select
Selection.Delete Shift:=xlUp
Range("D2").Select
ActiveWorkbook.SaveAs Filename:=RutaFactura, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Hoja12.Select
Range("D28:K" & F).Select
Selection.Copy
Hoja14.Select
Range("D10").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
Range("D10").End(xlDown).Select
FI = ActiveCell.Row + 1
Else
FI = 11
End If
FF = FI + Productos - 1
Range("J" & FI).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("D" & FI & ":D" & FF).Select
Selection = Factura
Range("E" & FI & ":E" & FF).Select
Selection = Prefijo
Range("F" & FI & ":F" & FF).Select
Selection = Fecha
Range("G" & FI & ":G" & FF).Select
Selection = Ano
Range("H" & FI & ":H" & FF).Select
Selection = Mes
Range("I" & FI & ":I" & FF).Select
Selection = Dia
Range("R" & FI & ":R" & FF).Select
Selection = Usuario
Hoja12.Select
Range("D28").Select
For I = 28 To F
CodigoHoja = Range("D" & I).Value
Codigo = Range("D" & I).Value
Producto = Range("E" & I).Value
Cantidad = Range("F" & I).Value
PrecioUnidad = Range("G" & I).Value
Sheets(CodigoHoja).Select
If Range("C14").Value <> "" Then
Range("C13").Select
Selection.End(xlDown).Select
FFF = ActiveCell.Row + 1
Else
FFF = 14
End If
Range("B" & FFF) = Fecha
Range("C" & FFF) = "Venta"
Range("D" & FFF) = RutaFactura
Range("E" & FFF) = Factura
Range("I" & FFF) = Cantidad
Hoja12.Select
Next
Hoja12.Select
Rows("28:" & F + 30).Select
Selection.Delete Shift:=xlUp
Range("E12").Select
FFFF = 4
Hoja10.Visible = xlSheetVisible
Hoja10.Select
Rows("4:" & FFFF + Productos).Select
Selection.ClearContents
Range("B3").Select
Hoja10.Visible = xlSheetHidden
Hoja12.Select
MsgBox "Se gener— la Factura " & RutaFactura & ".", vbInformation, "Factura Generada"
End If

Hoja13.Visible = xlSheetVisible
Hoja13.Select
If Range("L1").Value = "VERDADERO" Then
Hoja5.Select
ActiveSheet.PivotTables("Tabla dinámica1").PivotCache.Refresh
End If
'Hoja13.Visible = xlSheetHidden
Hoja12.Select
Application.ScreenUpdating = True

End Sub

1 respuesta

Respuesta
1

Actualizarlo por esto

Valora para finalizar la pregunta saludos!

Public Sub FacturarProductos1()
Dim Factura As Single
Dim Prefijo As String
Dim Fecha As Date
Dim Ano As Single
Dim Mes As Single
Dim Dia As Single
Dim Usuario As String
Dim F As Single
Dim FF As Single
Dim Productos As Single
Dim NombreArchivo As String
Dim ruta As String
Dim RutaFactura As String
Dim Codigo As Single
Dim CodigoHoja As String
Dim Producto As String
Dim Cantidad As Single
Dim PrecioUnidad As Double
Dim img As Shape
Dim NombreHojaFac As String
Dim NombreHojaFacAux As String

Application.ScreenUpdating = False

Fact = MsgBox("Estas seguro de generar la factura?", vbYesNo, "Generar Factura")
If Fact = vbYes Then
'' Hoja12.Select
'' If Range("D9").Value = "" Then
'' MsgBox "Actualmente no hay un Usuario autenticado para generar la factura.", vbCritical, "Autenticaci—n Usuario"
'' Range("D9").Select
'' Exit Sub
'' End If
''
'' Usuario = Range("D9").Value
If Range("D28").Value = "" Then
MsgBox "No hay productos para facturar " & Usuario & ".", vbExclamation, "Generar Facturar"
Range("D28").Select
Exit Sub
End If
Range("D27").End(xlDown).Select
F = ActiveCell.Row
Productos = ActiveCell.Row - 27
Factura = Range("E12").Value
Prefijo = Range("H12").Value
Fecha = Range("J12").Value
Ano = Range("A2").Value
Mes = Range("A3").Value
Dia = Range("A4").Value
Range("J12").Select
ActiveCell.FormulaR1C1 = "=NOW()"
NombreArchivo = Range("A1").Value
Hoja13.Visible = xlSheetVisible
ruta = Hoja13.Cells(4, 2).Text

RutaFactura = ruta & "\" 

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=RutaFactura & NombreArchivo & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Const ATTR_DIRECTORY = 16
If Dir$(ruta, ATTR_DIRECTORY) = "" Then
MsgBox ("El directorio para guardar las Facturas no existe")
'Hoja13.Visible = xlSheetHidden
Exit Sub
End If
'Hoja13.Visible = xlSheetHidden
Hoja10.Visible = xlSheetVisible
NombreHojaFac = Hoja12.Name
Sheets(NombreHojaFac).Select
Sheets(NombreHojaFac).Copy
Sheets(NombreHojaFac).Select
Range("E12:J12").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
For Each img In ActiveSheet.Shapes
If img.Type <> 13 Then img.Delete
Next
Rows("1:10").Select
Selection.Delete Shift:=xlUp
Range("D2").Select
ActiveWorkbook.SaveAs Filename:=RutaFactura, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Hoja12.Select
Range("D28:K" & F).Select
Selection.Copy
Hoja14.Select
Range("D10").Select
ActiveCell.Offset(1, 0).Select
If ActiveCell.Value <> "" Then
Range("D10").End(xlDown).Select
FI = ActiveCell.Row + 1
Else
FI = 11
End If
FF = FI + Productos - 1
Range("J" & FI).Select
Selection.PasteSpecial Paste:=xlPasteValues
Range("D" & FI & ":D" & FF).Select
Selection = Factura
Range("E" & FI & ":E" & FF).Select
Selection = Prefijo
Range("F" & FI & ":F" & FF).Select
Selection = Fecha
Range("G" & FI & ":G" & FF).Select
Selection = Ano
Range("H" & FI & ":H" & FF).Select
Selection = Mes
Range("I" & FI & ":I" & FF).Select
Selection = Dia
Range("R" & FI & ":R" & FF).Select
Selection = Usuario
Hoja12.Select
Range("D28").Select
For I = 28 To F
CodigoHoja = Range("D" & I).Value
Codigo = Range("D" & I).Value
Producto = Range("E" & I).Value
Cantidad = Range("F" & I).Value
PrecioUnidad = Range("G" & I).Value
Sheets(CodigoHoja).Select
If Range("C14").Value <> "" Then
Range("C13").Select
Selection.End(xlDown).Select
FFF = ActiveCell.Row + 1
Else
FFF = 14
End If
Range("B" & FFF) = Fecha
Range("C" & FFF) = "Venta"
Range("D" & FFF) = RutaFactura
Range("E" & FFF) = Factura
Range("I" & FFF) = Cantidad
Hoja12.Select
Next
Hoja12.Select
Rows("28:" & F + 30).Select
Selection.Delete Shift:=xlUp
Range("E12").Select
FFFF = 4
Hoja10.Visible = xlSheetVisible
Hoja10.Select
Rows("4:" & FFFF + Productos).Select
Selection.ClearContents
Range("B3").Select
Hoja10.Visible = xlSheetHidden
Hoja12.Select
MsgBox "Se gener— la Factura " & RutaFactura & ".", vbInformation, "Factura Generada"
End If

Hoja13.Visible = xlSheetVisible
Hoja13.Select
If Range("L1").Value = "VERDADERO" Then
Hoja5.Select
ActiveSheet.PivotTables("Tabla dinámica1").PivotCache.Refresh
End If
'Hoja13.Visible = xlSheetHidden
Hoja12.Select
Application.ScreenUpdating = True

End Sub

Muchas gracias por tu pronta respuesta:

Te comento que hice los cambios sugeridos y recibí el siguiente error y se generó una nueva hoja de Excel con los datos de la factura.

Saludos,

Envíame el archivo [email protected] para realizar los cambios saludos!

Muchas gracias, ya te envié el archivo.

Saludos,

Luis Fernando

Te envío el archivo

¡Gracias! Adriel

Muchas gracias por tu ayuda. Te comento lo siguiente:

Se está generando un archivo Libro2.xlsx en la ubicación C:\Users\user\Documents

Hice los ajustes de área de impresión y configuración de hoja para que se imprima únicamente lo que necesito, pero la hoja sale sin los valores de la factura como se ve en la foto.

Lo reviso y te envío

Te envié el archivo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas