Excel - Barra de progreso (Proceso DDE)

 
Vista:

Barra de progreso (Proceso DDE)

Publicado por Pablo (2 intervenciones) el 31/07/2006 18:54:00
Hice un macro en excel para efectuar una consulta sobre una base de datos access con MsQuery. La consulta almacena los campos para luego ponerlos en ciertos textboxes a llenar en un formulario de una hoja de datos.
Quisiera saber si existe la posibilidad de agregar una barra de progreso para el procedimiento ya que como la consulta se hace sobre otra unidad de red a veces tarda un tiempo.
Estuve fijandome en muchas páginas pero las unicas barras disponibles para excel son aquellas que redimensionan un "label" de color rojo sobre un "frame" basando su progreso en un calculo sobre una variable de un bucle, que evidentemente en este caso no sirve porque es un proceso externo al script, mismo al excel en si.
Mi pregunta es si puede usarse alguna de las barras clasicas del Visual Basic como Progressbar o algun OCX. Y de qué manera hacerlo.

Les dejo el código por las dudas:

Sub Buscar_en_dbRubros()
'Abre una consulta SQL y busca en la base rubros Access del path especificado los datos principales del cliente,
'despues los llena en el formulario.

Dim ParamRUE As Long
Dim ResulRUE, ResulNOM, ResulCALLE, ResulNUM, ResulLOC, ResulTARIFA As Variant

ParamRUE = TextBoxRue

Debug.Print ParamRUE
'
'On Error GoTo ErrorBusqueda
If (TextBoxRue <> "") Then
ActiveWorkbook.Worksheets.Add
ActiveSheet.Name = "Aux"
Worksheets("Aux").Visible = False
With Worksheets("Aux").QueryTables.Add(Connection:=Array(Array( _
"ODBC;DSN=MS Access Database;DBQ=M:\01-PERDIDAS FOCALIZADAS\EMILIO\Base_Anual\Rubros_Nueva.mdb;DefaultDir=M:\01-PERDI" _
), Array( _
"DAS FOCALIZADAS\EMILIO\Base_Anual;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;" _
)), Destination:=Worksheets("Aux").Range("A1"))
.CommandText = Array( _
"SELECT Datos_Clientes.RUE, Datos_Clientes.NOMBRE, Datos_Clientes.CALLE, Datos_Clientes.NUM, Datos_Clientes.LOCALIDAD, Datos_Clientes.TARIFA_S" & Chr(13) & "" & Chr(10) & "FROM Datos_Clientes Datos_Clientes" & Chr(13) & "" & Chr(10) & "WHERE (Datos_Clientes" _
, ".RUE=" & Str(ParamRUE) & ")")
.Name = "Consulta desde MS Access Database"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.Refresh BackgroundQuery:=False
End With
ResulRUE = Worksheets("Aux").Cells(2, 1).Value
ResulNOM = Worksheets("Aux").Cells(2, 2).Value
ResulCALLE = Worksheets("Aux").Cells(2, 3).Value
ResulNUM = Worksheets("Aux").Cells(2, 4).Value
ResulLOC = Worksheets("Aux").Cells(2, 5).Value
ResulTARIFA = Worksheets("Aux").Cells(2, 6).Value

If ResulRUE = "" Then
'Cells.Select
'Selection.ClearContents
Application.DisplayAlerts = False
Worksheets("Aux").Delete
Application.DisplayAlerts = True
MsgBox "RUE no encontrado en base.", , "Aviso"
Exit Sub
End If

'Worksheets("Aux").Cells.Select
'Selection.ClearContents

Application.DisplayAlerts = False
Worksheets("Aux").Delete
Application.DisplayAlerts = True

Debug.Print ResulRUE
Debug.Print ResulNOM
Debug.Print ResulCALLE
Debug.Print ResulNUM
Debug.Print ResulLOC
Debug.Print ResulTARIFA
Dim ResulDIR As Variant
ResulDIR = "" & ResulCALLE & "" & Str(ResulNUM) & ""
TextBoxNombre = ResulNOM
TextBoxDireccion = ResulDIR
'ResulNUM
TextBoxLocalidad = ResulLOC
ComboBoxTarifa = ResulTARIFA
Else
MsgBox "RUE vacío o erróneo. Verificar entrada", , "Aviso"
End If

End Sub

Gracias.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder