145 lines
5.1 KiB
Plaintext
145 lines
5.1 KiB
Plaintext
' Module: ExportUtils
|
|
' Description: Functions for exporting data to different formats
|
|
|
|
Public Function ExportToPDF(ws As Worksheet, fechaDesde As String, fechaHasta As String) As Boolean
|
|
Dim rutaPDF As String
|
|
Dim nombreArchivo As String
|
|
|
|
' Construct PDF filename based on the dates
|
|
nombreArchivo = "fdl_" & fechaDesde & " al " & fechaHasta & ".pdf"
|
|
|
|
' Show "Save As" dialog and get the selected path
|
|
rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _
|
|
FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Guardar como PDF")
|
|
|
|
' Check if user cancelled the dialog
|
|
If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then
|
|
' Export sheet as PDF
|
|
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutaPDF, _
|
|
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
|
|
IgnorePrintAreas:=False, OpenAfterPublish:=False
|
|
ExportToPDF = True
|
|
Else
|
|
ExportToPDF = False
|
|
End If
|
|
End Function
|
|
|
|
Public Function ExportToExcel(fechaDesde As String, fechaHasta As String) As Boolean
|
|
Dim rutaPDF As String
|
|
Dim nombreArchivo As String
|
|
Dim ws As Worksheet
|
|
Dim links As Variant
|
|
Dim i As Long
|
|
|
|
' Construir el nombre del archivo basado en las fechas
|
|
nombreArchivo = "fdl_" & fechaDesde & " al " & fechaHasta & ".xlsx"
|
|
|
|
' Mostrar el diálogo "Guardar Como" y obtener la ruta seleccionada
|
|
rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _
|
|
FileFilter:="XLS Files (*.xlsx), *.xlsx", Title:="Guardar como XLS")
|
|
|
|
' Verificar si el usuario canceló el diálogo
|
|
If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then
|
|
Dim Hoja1 As Worksheet, Hoja2 As Worksheet, Hoja3 As Worksheet, Hoja4 As Worksheet, Hoja5 As Worksheet
|
|
Dim NuevoLibro As Workbook
|
|
|
|
' Establecer referencias a las hojas originales
|
|
Set Hoja1 = ThisWorkbook.Sheets(SHEET_NOTA)
|
|
Set Hoja2 = ThisWorkbook.Sheets(SHEET_FDL_1)
|
|
Set Hoja3 = ThisWorkbook.Sheets(SHEET_FDL_2)
|
|
Set Hoja4 = ThisWorkbook.Sheets(SHEET_FDL_3)
|
|
Set Hoja5 = ThisWorkbook.Sheets(SHEET_FOGLIO_1)
|
|
|
|
' Copiar la primera hoja al nuevo libro
|
|
Hoja1.Copy
|
|
Set NuevoLibro = ActiveWorkbook
|
|
|
|
' Copiar el resto de las hojas al nuevo libro
|
|
Hoja2.Copy After:=NuevoLibro.Sheets(1)
|
|
Hoja3.Copy After:=NuevoLibro.Sheets(2)
|
|
Hoja4.Copy After:=NuevoLibro.Sheets(3)
|
|
Hoja5.Copy After:=NuevoLibro.Sheets(4)
|
|
|
|
' Aplicar .Value = .Value a todas las hojas para convertir fórmulas en valores
|
|
For Each ws In NuevoLibro.Worksheets
|
|
ws.UsedRange.value = ws.UsedRange.value
|
|
Next ws
|
|
|
|
' Obtener los links externos del nuevo libro
|
|
links = NuevoLibro.LinkSources(Type:=xlLinkTypeExcelLinks)
|
|
|
|
' Si existen links externos, recorrer todas las hojas y reemplazar el texto del link
|
|
' If Not IsEmpty(links) Then
|
|
' For Each ws In NuevoLibro.Worksheets
|
|
' For i = LBound(links) To UBound(links)
|
|
' ws.Cells.Replace What:=links(i), Replacement:="", LookAt:=xlPart, _
|
|
' SearchOrder:=xlByRows, MatchCase:=False
|
|
' Next i
|
|
' Next ws
|
|
' End If
|
|
|
|
' Guardar y cerrar el nuevo libro
|
|
NuevoLibro.SaveAs rutaPDF, FileFormat:=xlWorkbookDefault
|
|
NuevoLibro.Close SaveChanges:=False
|
|
|
|
ExportToExcel = True
|
|
Else
|
|
ExportToExcel = False
|
|
End If
|
|
End Function
|
|
|
|
|
|
|
|
Public Function ExportComessaToExcel() As Boolean
|
|
Dim rutaPDF As String
|
|
Dim nombreArchivo As String
|
|
Dim wsComesse As Worksheet
|
|
Dim fechaDesde As Date
|
|
Dim n As Integer
|
|
|
|
' Set reference to Commesse sheet
|
|
Set wsComesse = ThisWorkbook.Sheets(SHEET_COMMESSE)
|
|
|
|
' Find the date to use in filename
|
|
For n = 1 To 7
|
|
If wsComesse.Cells(8, 2 * n).Value2 <> 0 Then
|
|
fechaDesde = wsComesse.Cells(2, 2 * n).Value2
|
|
End If
|
|
Next n
|
|
|
|
' Build filename
|
|
nombreArchivo = "C:\Users\migue\OneDrive\Miguel\CSA - Trabajo\2024\Angelo Comesse\" + _
|
|
"Ore " & Format(fechaDesde, "dd-MM") & " Vera Miguel.xlsx"
|
|
|
|
' Show Save dialog
|
|
rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _
|
|
FileFilter:="XLS Files (*.xlsx), *.xlsx", Title:="Guardar como XLS")
|
|
|
|
If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then
|
|
Dim NuevoLibro As Workbook
|
|
Dim NuevaHoja As Worksheet
|
|
|
|
' Create new workbook and copy data
|
|
Set NuevoLibro = Workbooks.Add
|
|
Set NuevaHoja = NuevoLibro.Sheets(1)
|
|
|
|
wsComesse.Cells.Copy
|
|
With NuevaHoja.Cells
|
|
.PasteSpecial Paste:=xlPasteValues
|
|
.PasteSpecial Paste:=xlPasteFormats
|
|
End With
|
|
Application.CutCopyMode = False
|
|
|
|
' Save the new workbook
|
|
NuevoLibro.SaveAs rutaPDF, FileFormat:=xlWorkbookDefault
|
|
|
|
' Close the new workbook
|
|
NuevoLibro.Close SaveChanges:=False
|
|
|
|
ExportComessaToExcel = True
|
|
Else
|
|
ExportComessaToExcel = False
|
|
End If
|
|
End Function
|
|
|