PlanillaHoras_VBA/ConsultarFechas.vba

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