228 lines
8.1 KiB
Plaintext
228 lines
8.1 KiB
Plaintext
Dim b_Export As Boolean
|
|
|
|
Private Sub b_completar_Click()
|
|
|
|
b_Export = False
|
|
CopiarCeldas
|
|
|
|
Unload Me
|
|
|
|
End Sub
|
|
|
|
Private Sub b_completar_exportar_Click()
|
|
|
|
b_Export = True
|
|
CopiarCeldas
|
|
|
|
Unload Me
|
|
|
|
End Sub
|
|
|
|
|
|
Sub CopiarCeldas()
|
|
Dim wsHoras As Worksheet, wsFdl As Worksheet
|
|
Dim fechaDesde As Date, fechaHasta As Date
|
|
Dim ultimaFilaConDatos As Long, ultimaFilaHoras As Long
|
|
Dim i As Long, j As Long, k As Integer
|
|
Dim respuesta As VbMsgBoxResult
|
|
Dim nombreHojaHoras As String, nombreHojaFdl_1 As String, nombreHojaFdl_2 As String, nombreHojaFdl_3 As String, nombreHojaNota As String
|
|
Dim pdfExportado As Boolean
|
|
Const PrimeraFilaFDL = 17
|
|
|
|
|
|
' Nombres de las hojas en variables estáticas
|
|
nombreHojaHoras = "Horas"
|
|
nombreHojaFdl_1 = "FDL_1"
|
|
nombreHojaFdl_2 = "FDL_2"
|
|
nombreHojaFdl_3 = "FDL_3"
|
|
nombreHojaNota = "Nota"
|
|
|
|
' Establecer referencias a las hojas de trabajo
|
|
Set wsHoras = ThisWorkbook.Sheets(nombreHojaHoras)
|
|
Set wsFdl = ThisWorkbook.Sheets(nombreHojaFdl_1)
|
|
|
|
ultimaFilaHoras = wsHoras.Cells(Rows.Count, 5).End(xlUp).Row
|
|
|
|
' Leer fechas desde los TextBox del formulario
|
|
On Error Resume Next
|
|
|
|
|
|
fechaDesde = GetDateFromForm(ConsultarFechas.t_desde.value)
|
|
fechaHasta = GetDateFromForm(ConsultarFechas.t_hasta.value)
|
|
|
|
' Escribir el numero de factura
|
|
ThisWorkbook.Sheets(nombreHojaNota).Cells(6, 3).value = ConsultarFechas.frm_factnro.value
|
|
|
|
' Validar que las fechas son correctas
|
|
If IsEmpty(fechaDesde) Or IsEmpty(fechaHasta) Then
|
|
MsgBox "Por favor, ingrese fechas válidas."
|
|
Exit Sub
|
|
End If
|
|
|
|
On Error GoTo 0
|
|
|
|
' Validar que las fechas son correctas
|
|
If IsEmpty(fechaDesde) Or IsEmpty(fechaHasta) Then
|
|
MsgBox "Por favor, ingrese fechas válidas."
|
|
Exit Sub
|
|
End If
|
|
|
|
' Comprobar que el rango de fechas no excede los 31 días
|
|
If fechaHasta - fechaDesde > 31 Then
|
|
MsgBox "El rango de fechas no puede exceder los 31 días."
|
|
Exit Sub
|
|
End If
|
|
|
|
' Preguntar al usuario si desea borrar el contenido selectivo de FDL_1
|
|
'respuesta = MsgBox("¿Desea borrar el contenido selectivo de la hoja FDL ?", vbYesNo)
|
|
'If respuesta = vbYes Then
|
|
wsFdl.Range("A17:P44").ClearContents
|
|
ThisWorkbook.Sheets(nombreHojaFdl_2).Range("A17:P44").ClearContents
|
|
ThisWorkbook.Sheets(nombreHojaFdl_3).Range("A17:P44").ClearContents
|
|
'End If
|
|
|
|
|
|
' Iniciar variable para la fila de destino
|
|
j = PrimeraFilaFDL ' Puesto que quieres empezar desde la fila 17 en FDL_1
|
|
k = 0
|
|
|
|
' Recorrer cada fila en la hoja "Horas"
|
|
For i = 3 To ultimaFilaHoras
|
|
If CDate(wsHoras.Cells(i, 5).Value2) >= fechaDesde And CDate(wsHoras.Cells(i, 5).Value2) <= fechaHasta Then
|
|
' Copiar la celda a la hoja "FDL_1/2/3"
|
|
wsFdl.Cells(j, 1).Value2 = wsHoras.Cells(i, 5).Value2
|
|
wsFdl.Cells(j, 3).value = Format(wsHoras.Cells(i, 6).value, "hh:mm")
|
|
wsFdl.Cells(j, 4).value = wsHoras.Cells(i, 7).value
|
|
wsFdl.Cells(j, 5).value = wsHoras.Cells(i, 8).value
|
|
wsFdl.Cells(j, 6).value = wsHoras.Cells(i, 9).value
|
|
If wsHoras.Cells(i, 14).value > 0 Then wsFdl.Cells(j, 7).value = wsHoras.Cells(i, 14).value
|
|
If wsHoras.Cells(i, 15).value > 0 Then wsFdl.Cells(j, 8).value = wsHoras.Cells(i, 15).value
|
|
wsFdl.Cells(j, 10).value = wsHoras.Cells(i, 2).value
|
|
j = j + 2: k = k + 1
|
|
pdfExportado = False
|
|
If k = 14 Then
|
|
ExportarAsPDF wsFdl, Format(fechaDesde, "dd-MM"), Format(wsFdl.Cells(j - 2, 1).Value2, "dd-MM")
|
|
|
|
Set wsFdl = ThisWorkbook.Sheets(nombreHojaFdl_2)
|
|
j = PrimeraFilaFDL
|
|
pdfExportado = True
|
|
End If
|
|
If k = 28 Then
|
|
ExportarAsPDF wsFdl, Format(wsFdl.Cells(PrimeraFilaFDL, 1).Value2, "dd-MM"), Format(wsFdl.Cells(j - 2, 1).Value2, "dd-MM")
|
|
|
|
Set wsFdl = ThisWorkbook.Sheets(nombreHojaFdl_3)
|
|
j = PrimeraFilaFDL
|
|
pdfExportado = True
|
|
End If
|
|
|
|
' Si j supera 42, salir del bucle
|
|
If k > 42 Then Exit For
|
|
End If
|
|
Next i
|
|
If Not pdfExportado Then
|
|
ExportarAsPDF wsFdl, Format(wsFdl.Cells(PrimeraFilaFDL, 1).Value2, "dd-MM"), Format(fechaHasta, "dd-MM")
|
|
End If
|
|
|
|
' Exportar la factura
|
|
ExportarAsPDF ThisWorkbook.Sheets(nombreHojaNota), "Fattura_" & Format(fechaDesde, "dd-MM"), Format(fechaHasta, "dd-MM")
|
|
|
|
' Exportar la factura
|
|
ExportarAsPDF ThisWorkbook.Sheets("Foglio 1"), "Expenses_" & Format(fechaDesde, "dd-MM"), Format(fechaHasta, "dd-MM")
|
|
|
|
ExportarAsXLS "Expenses_" & Format(fechaDesde, "dd-MM"), Format(fechaHasta, "dd-MM")
|
|
|
|
' Limpiar objetos
|
|
Set wsFdl = Nothing
|
|
|
|
End Sub
|
|
|
|
|
|
Private Sub ExportarAsPDF(wsFdl As Worksheet, fechaDesde As String, fechaHasta As String)
|
|
Dim rutaPDF As String
|
|
Dim nombreArchivo As String
|
|
|
|
If b_Export Then
|
|
|
|
' Construir el nombre del archivo PDF basado en las fechas
|
|
nombreArchivo = "fdl_" & fechaDesde & " al " & fechaHasta & ".pdf"
|
|
|
|
|
|
' Mostrar el cuadro de diálogo "Guardar como" y obtener la ruta seleccionada
|
|
rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _
|
|
FileFilter:="PDF Files (*.pdf), *.pdf", Title:="Guardar como PDF")
|
|
|
|
' Comprobar si el usuario ha cancelado el cuadro de diálogo
|
|
If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then
|
|
' Exportar la hoja como PDF
|
|
wsFdl.ExportAsFixedFormat Type:=xlTypePDF, Filename:=rutaPDF, _
|
|
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
|
|
IgnorePrintAreas:=False, OpenAfterPublish:=False
|
|
End If
|
|
|
|
End If
|
|
End Sub
|
|
|
|
Private Sub ExportarAsXLS(fechaDesde As String, fechaHasta As String)
|
|
Dim rutaPDF As String
|
|
Dim nombreArchivo As String
|
|
|
|
If b_Export Then
|
|
|
|
' Construir el nombre del archivo PDF basado en las fechas
|
|
nombreArchivo = "fdl_" & fechaDesde & " al " & fechaHasta & ".xlsx"
|
|
|
|
|
|
' Mostrar el cuadro de diálogo "Guardar como" y obtener la ruta seleccionada
|
|
rutaPDF = Application.GetSaveAsFilename(InitialFileName:=nombreArchivo, _
|
|
FileFilter:="XLS Files (*.xlsx), *.xlsx", Title:="Guardar como XLS")
|
|
|
|
' Comprobar si el usuario ha cancelado el cuadro de diálogo
|
|
If (rutaPDF <> "False") And (rutaPDF <> "Falso") Then
|
|
' Exportar la hoja como PDF
|
|
|
|
Dim Hoja1 As Worksheet, Hoja2 As Worksheet, Hoja3 As Worksheet, Hoja4 As Worksheet, Hoja5 As Worksheet
|
|
Dim NuevoLibro As Workbook
|
|
|
|
' Ajusta los nombres de las hojas a los que necesitas
|
|
Set Hoja1 = ThisWorkbook.Sheets("Nota")
|
|
Set Hoja2 = ThisWorkbook.Sheets("FDL_1")
|
|
Set Hoja3 = ThisWorkbook.Sheets("FDL_2")
|
|
Set Hoja4 = ThisWorkbook.Sheets("FDL_3")
|
|
Set Hoja5 = ThisWorkbook.Sheets("Foglio 1")
|
|
|
|
|
|
' Copia las hojas a un nuevo libro
|
|
Hoja1.Copy
|
|
Set NuevoLibro = ActiveWorkbook
|
|
|
|
' Con el nuevo libro activo, copia la segunda hoja
|
|
Hoja2.Copy After:=NuevoLibro.Sheets(1)
|
|
Hoja3.Copy After:=NuevoLibro.Sheets(2)
|
|
Hoja4.Copy After:=NuevoLibro.Sheets(3)
|
|
Hoja5.Copy After:=NuevoLibro.Sheets(4)
|
|
|
|
' Guarda el nuevo libro como archivo .xls
|
|
' Cambia la ruta de archivo y el nombre según necesites
|
|
NuevoLibro.SaveAs rutaPDF, FileFormat:=xlWorkbookDefault
|
|
|
|
' Cierra el nuevo libro sin guardar cambios
|
|
NuevoLibro.Close SaveChanges:=False
|
|
|
|
End If
|
|
|
|
End If
|
|
End Sub
|
|
|
|
|
|
|
|
Public Function GetDateFromForm(value As String) As Date
|
|
Dim partesFecha() As String
|
|
|
|
' Leer fecha desde el TextBox t_desde
|
|
partesFecha = Split(value, "/")
|
|
On Error Resume Next
|
|
GetDateFromForm = DateSerial(CInt(partesFecha(2)), CInt(partesFecha(1)), CInt(partesFecha(0)))
|
|
On Error GoTo 0
|
|
End Function
|
|
|