2

Tengo una consulta y es la siguiente:

Tengo un método que realiza la exportación del excel pero el problema es al dar click al boton descargar abre excel con los datos de la consulta pero a la vez ya guardo el archivo en la ruta especificada.

Deseo que al dar click al descargar abra excel con los datos cargados de la consulta y al intentar cerrar recien realize la pregunta si deseas guardar el archivo si es SI lo guarde en una ruta que se especifique en el momento pero si es NO simplemente no se guarde.

Además de ello ese método exportar_rs deja ejecutando los excel guardados en segundo plano ya que intento borrarlos y no me deja.

Script

Private Sub exportar_rs(rs As Recordset)
On Error GoTo MensajeError

'--Cambiamos el icono del cursor(Modo Espera)
Me.MousePointer = vbHourglass

'--Creamos el objeto para trabajo con excel
Set Obj_Excel = CreateObject("Excel.Application")
'--Creamos el libro con el que trabajaremos - Este archivo debe existir
Dim nombreFile As String
Dim fecha As String
fecha = Format(Now, "ddMMyyyyHHmmss")
nombreFile = "\ReporteCita" + fecha + ".xlsx"
Set Obj_Libro = Obj_Excel.Workbooks.Add
Obj_Libro.SaveAs App.Path & nombreFile
'--Indicamos la hoja de excel
Set Obj_Hoja = Obj_Excel.ActiveSheet

'Llenar filas en excel
Obj_Hoja.Range("A2:B2").MergeCells = True
Obj_Hoja.Range("A2:B2").Font.Bold = True
Obj_Hoja.Range("A2:B2").WrapText = True
Obj_Hoja.Range("A2:B2").HorizontalAlignment = xlCenter
Obj_Hoja.Range("A2:B2").Font.Color = vbWhite
Obj_Hoja.Range("A2:B2").Font.Size = 14
Obj_Hoja.Cells(2, 1) = "Reporte de Orden Cita Retiro"

Dim fila As Integer
fila = 3
rs.MoveFirst
Do Until rs.EOF
    Obj_Hoja.Cells(fila + 1, 1) = "Nro Orden Retiro"
    Obj_Hoja.Cells(fila + 2, 1) = "Contenedor"
    Obj_Hoja.Cells(fila + 3, 1) = "Fecha Retiro"
    Obj_Hoja.Cells(fila + 4, 1) = "Hora Retiro"
    Obj_Hoja.Cells(fila + 5, 1) = "Placa"
    Obj_Hoja.Cells(fila + 6, 1) = "Chofer"
    Obj_Hoja.Cells(fila + 7, 1) = "Fecha Creacion"
    
    'Llenar los valores de la consulta
    Obj_Hoja.Cells(fila + 1, 2) = rs!CitaOrdenRetiro
    Obj_Hoja.Cells(fila + 2, 2) = rs!Contenedor
    If IsNull(rs!FechaRetiro) Then
        Obj_Hoja.Cells(fila + 3, 2) = ""
    Else
        Obj_Hoja.Cells(fila + 3, 2) = CDate(rs!FechaRetiro)
    End If
    
    Obj_Hoja.Cells(fila + 4, 2) = rs!HoraRetiro
    Obj_Hoja.Cells(fila + 5, 2) = rs!Placa
    Obj_Hoja.Cells(fila + 6, 2) = rs!Chofer
    If IsNull(rs!FechaCreacion) Then
        Obj_Hoja.Cells(fila + 7, 2) = ""
    Else
        Obj_Hoja.Cells(fila + 7, 2) = CDate(rs!FechaCreacion)
    End If
    
    fila = fila + 10
rs.MoveNext
Loop


Obj_Excel.Visible = True

'--Damos formato a la cabecera
With Obj_Hoja
    .Columns(1).Font.Bold = True 'Grosor de la fuente
    .Columns("A:B").AutoFit 'Auto ajustar la cabecera
    .Columns(2).HorizontalAlignment = xlRight 'Alinear valores a la izquierda
    .Range("A2:B2").Interior.ColorIndex = 3 'Pintar celda 3 = Rojo
End With

'--Eliminar las variables de objeto excel
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing

'--Restaurar cursor
Me.MousePointer = vbDefault

Exit Sub
'--Controlar errores
MensajeError:
    MsgBox Err.Description, vbCritical
On Error Resume Next

'--Destruir variables de excel
Set Obj_Hoja = Nothing
Set Obj_Libro = Nothing
Set Obj_Excel = Nothing
Me.MousePointer = vbDefault '--Devolver puntero

End Sub

1 respuesta 1

3

Prueba así:

Private Sub exportar_rs(rs As Recordset)
    On Error GoTo MensajeError
    
    '--Cambiamos el icono del cursor(Modo Espera)
    Me.MousePointer = vbHourglass
    
    '--Creamos el objeto para trabajo con excel
    Set Obj_Excel = CreateObject("Excel.Application")
    '--Creamos el libro con el que trabajaremos - Este archivo debe existir
    Dim nombreFile As String
    Dim fecha As String
    Dim pregunta As String
    
    fecha = Format(Now, "ddMMyyyyHHmmss")
    nombreFile = "\ReporteCita" + fecha + ".xlsx"
    Set Obj_Libro = Obj_Excel.Workbooks.Add
    'Obj_Libro.SaveAs App.Path & nombreFile
    '--Indicamos la hoja de excel
    Set Obj_Hoja = Obj_Excel.ActiveSheet
    
    'Llenar filas en excel
    Obj_Hoja.Range("A2:B2").MergeCells = True
    Obj_Hoja.Range("A2:B2").Font.Bold = True
    Obj_Hoja.Range("A2:B2").WrapText = True
    Obj_Hoja.Range("A2:B2").HorizontalAlignment = xlCenter
    Obj_Hoja.Range("A2:B2").Font.Color = vbWhite
    Obj_Hoja.Range("A2:B2").Font.Size = 14
    Obj_Hoja.Cells(2, 1) = "Reporte de Orden Cita Retiro"
    
    Dim fila As Integer
    fila = 3
    rs.MoveFirst
    Do Until rs.EOF
        Obj_Hoja.Cells(fila + 1, 1) = "Nro Orden Retiro"
        Obj_Hoja.Cells(fila + 2, 1) = "Contenedor"
        Obj_Hoja.Cells(fila + 3, 1) = "Fecha Retiro"
        Obj_Hoja.Cells(fila + 4, 1) = "Hora Retiro"
        Obj_Hoja.Cells(fila + 5, 1) = "Placa"
        Obj_Hoja.Cells(fila + 6, 1) = "Chofer"
        Obj_Hoja.Cells(fila + 7, 1) = "Fecha Creacion"
        
        'Llenar los valores de la consulta
        Obj_Hoja.Cells(fila + 1, 2) = rs!CitaOrdenRetiro
        Obj_Hoja.Cells(fila + 2, 2) = rs!Contenedor
        If IsNull(rs!FechaRetiro) Then
            Obj_Hoja.Cells(fila + 3, 2) = ""
        Else
            Obj_Hoja.Cells(fila + 3, 2) = CDate(rs!FechaRetiro)
        End If
        
        Obj_Hoja.Cells(fila + 4, 2) = rs!HoraRetiro
        Obj_Hoja.Cells(fila + 5, 2) = rs!Placa
        Obj_Hoja.Cells(fila + 6, 2) = rs!Chofer
        If IsNull(rs!FechaCreacion) Then
            Obj_Hoja.Cells(fila + 7, 2) = ""
        Else
            Obj_Hoja.Cells(fila + 7, 2) = CDate(rs!FechaCreacion)
        End If
        
        fila = fila + 10
    rs.MoveNext
    Loop
    
    
    Obj_Excel.Visible = True
    
    '--Damos formato a la cabecera
    With Obj_Hoja
        .Columns(1).Font.Bold = True 'Grosor de la fuente
        .Columns("A:B").AutoFit 'Auto ajustar la cabecera
        .Columns(2).HorizontalAlignment = xlRight 'Alinear valores a la izquierda
        .Range("A2:B2").Interior.ColorIndex = 3 'Pintar celda 3 = Rojo
    End With
    
    'Una vez terminas de dar formato al libro preguntamos si lo cerramos o si lo dejamos abierto
    pregunta = MsgBox("¿Deseas guardar y cerrar el libro o bien lo mantengo abierto?", vbYesNo, "Atención")
    
    'Si he respondido "SI" guardo el libro y lo cierro
    If pregunta = vbYes Then
        Obj_Libro.SaveAs App.Path & nombreFile
        Obj_Libro.Close savechanges:=False
    End If
    
    '--Eliminar las variables de objeto excel
    Set Obj_Hoja = Nothing
    Set Obj_Libro = Nothing
    Set Obj_Excel = Nothing
    
    '--Restaurar cursor
    Me.MousePointer = vbDefault
    
    Exit Sub
    '--Controlar errores
MensajeError:
        MsgBox Err.Description, vbCritical
    On Error Resume Next
    
    '--Destruir variables de excel
    Set Obj_Hoja = Nothing
    Set Obj_Libro = Nothing
    Set Obj_Excel = Nothing
    Me.MousePointer = vbDefault '--Devolver puntero

End Sub
1
  • si quiero que la ruta donde se va a guardar la especifiquen.
    – Darwin
    el 28 may. 2021 a las 15:01

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.