Ocultar barra de descarga cuando abro Libro Excel

Estimados Todoexpert@s.

Tengo un libro en el que realizo búsquedas y esta en un carpeta compartida de la red.

Al momento de ejecutar la macro y abrir el libro con WorkBook. Open(), se muestra una barra de carga

Como podría hacer para que no se mostrara y la ejecución de la macro fuera transparente al usuario.

Tengo configurado:

...

With Application

          .ScreenUpdating = False

          .DisplayAlerts = False

...

1 respuesta

Respuesta

[Hola

Ese cuadro de dialogo no depende del VBA, es predeterminado por Excel. Hay una forma con Hook(ing) y funciones de la API de Windows pero, tendrías que entenderlo, adaptarlo a lo que tienes y probarlo.

En un módulo estándar copia y pega esto:

' WINDOWS API FUNCTIONS:
Public Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
Public Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
Public Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
' CONSTANT VARIABLES:
Public Const SW_HIDE = 0
Public Const DLG_CLSID = "CMsoProgressBarWindow"
Public Const EVENT_SYSTEM_FOREGROUND = &H3&
Public Const WINEVENT_OUTOFCONTEXT = 0
' GLOBAL VARIABLES:
Dim long_WinEventHook As Long
Function StartEventHook() As Long
 long_WinEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
 StartEventHook = long_WinEventHook
End Function
Sub StopEventHook()
 Dim b_unhooked As Boolean
 If long_WinEventHook = 0 Then
  MsgBox "WinEventHook couldn't be stopped! " & _
  "Variable 'long_WinEventHook' is empty! " & _
  "Better restart Windows now!"
  Exit Sub
 End If
 b_unhooked = UnhookWinEvent(long_WinEventHook)
 If b_unhooked = True Then
 Else
  MsgBox "WinEventHook couldn't be stopped! " & _
  "Variable 'b_unhooked' is false! " & _
  "Better restart Windows now!"
 End If
End Sub
' CALLBACK FUNC OF "SetWinEventHook" (DEFINE ACTIONS TO RUN ON THE EVENTS):
' http://stackoverflow.com/questions/20486944/detecting-in-vba-when-the-window-containing-an-excel-instance-becomes-active
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
 'This function is a callback passed to the win32 api
 'We CANNOT throw an error or break. Bad things will happen
 On Error Resume Next
 Dim l_handle As Long
 Dim s_buffer As String
 Dim b_visible As Boolean
 Dim i_bufferLength As Integer
 s_buffer = String$(32, 0)
 i_bufferLength = apiGetClassName(hWnd, s_buffer, Len(s_buffer))
 If Left(s_buffer, i_bufferLength) = DLG_CLSID Then
  b_visible = apiShowWindow(hWnd, SW_HIDE)
  WinEventFunc = hWnd
 End If
End Function

Luego en tu macro debes colocar algo así:

Sub TuMacro()
Call StartEventHook
'aquí tu código con el que guardas
Call StopEventHook
End Sub

Comentas

Abraham Valencia

Gracias Abraham por tu pronta respuesta.

Lo voy a probar. Pero tengo una duda: Navegando por Internet encontré una función que oculta la barra de tarea, pero al momento de compilarla me sale que esa función no esta aplicada para sistemas de 64bits y que no podías compilarlo. Tengo Office 2016 x64.

Esa duda me sale cuando leo las siguientes librerías:

Hoy por la tarde lo pruebo y subo capturas. Gracias nuevamente, :-)

Parece que justamente es lo que te envié. Para que sea útil en Office de 32 o 64 bits, basta cambiar las primeras línea así:

#If VBA7 Then
    Public Declare PtrSafe Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
    Public Declare PtrSafe Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
    Public Declare PtrSafe Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
    Public Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
    Public Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
    Public Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
    Public Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
    Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If

Saludos]

Abraham Valencia

[Hola Abraham:

Probé lo que me enviaste, y lo coloque como declaración de variables y apareció esto:

Resaltando esto:

Además las lineas de código en rojo, dan error de compilación.

Así que las comente, pensando que el error que aparece en la ventana podía deberse a que aparecen dos lineas parecidas. Pero me sigue apareciendo el error de comentario después de End Sub, etc.

Así coloque el código:

#If VBA7 Then
    Public Declare PtrSafe Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
    Public Declare PtrSafe Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
    Public Declare PtrSafe Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
    Public Declare PtrSafe Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#Else
    Public Declare Function SetWinEventHook Lib "user32" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
    Public Declare Function UnhookWinEvent Lib "user32" (ByVal hWinEventHook As Long) As Long
    Public Declare Function apiGetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassname As String, ByVal nMaxCount As Long) As Long
    Public Declare Function apiShowWindow Lib "user32" Alias "ShowWindow" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
#End If
' CONSTANT VARIABLES:
Public Const SW_HIDE = 0
Public Const DLG_CLSID = "CMsoProgressBarWindow"
Public Const EVENT_SYSTEM_FOREGROUND = &H3&
Public Const WINEVENT_OUTOFCONTEXT = 0
' GLOBAL VARIABLES:
Dim long_WinEventHook As Long
Function StartEventHook() As Long
 long_WinEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventFunc, 0, 0, WINEVENT_OUTOFCONTEXT)
 StartEventHook = long_WinEventHook
End Function
Sub StopEventHook()
 Dim b_unhooked As Boolean
 If long_WinEventHook = 0 Then
  MsgBox "WinEventHook couldn't be stopped! " & _
  "Variable 'long_WinEventHook' is empty! " & _
  "Better restart Windows now!"
  Exit Sub
 End If
 b_unhooked = UnhookWinEvent(long_WinEventHook)
 If b_unhooked = True Then
 Else
  MsgBox "WinEventHook couldn't be stopped! " & _
  "Variable 'b_unhooked' is false! " & _
  "Better restart Windows now!"
 End If
End Sub
' CALLBACK FUNC OF "SetWinEventHook" (DEFINE ACTIONS TO RUN ON THE EVENTS):
' http://stackoverflow.com/questions/20486944/detecting-in-vba-when-the-window-containing-an-excel-instance-becomes-active
Public Function WinEventFunc(ByVal HookHandle As Long, ByVal LEvent As Long, ByVal hWnd As Long, ByVal idObject As Long, ByVal idChild As Long, ByVal idEventThread As Long, ByVal dwmsEventTime As Long) As Long
 'This function is a callback passed to the win32 api
 'We CANNOT throw an error or break. Bad things will happen
 On Error Resume Next
 Dim l_handle As Long
 Dim s_buffer As String
 Dim b_visible As Boolean
 Dim i_bufferLength As Integer
 s_buffer = String$(32, 0)
 i_bufferLength = apiGetClassName(hWnd, s_buffer, Len(s_buffer))
 If Left(s_buffer, i_bufferLength) = DLG_CLSID Then
  b_visible = apiShowWindow(hWnd, SW_HIDE)
  WinEventFunc = hWnd
 End If
End Function

Gracias Abraham, nuevamente ¿Qué estaré haciendo mal?.

Saludos.

[Hola

En office de 64 bits una parte siempre se verá roja, pero no te preocupes, con el #If se evita que lo tome como error. La idea es que sirva tanto en 64 como en 32 bits (por si acaso). Algo muy importante, no puede ir nada líneas arribas de la declaración de las funciones de la API, nada, qui´z tienes algo ahí y por eso el problema. Ah, y repito algo que ya te había escrito, eso se usa en un módulo estándar, ojo con eso.

Abraham Valencia

Gracias Abraham. Efectivamente, no debe haber nada encima del #If lo he colocado en un nuevo modulo. Pero ahora sucede esto:

Ahora que habré hecho mal?.  Gracias de antemano.

Saludos,

[Hola

Hoy sí estoy en mi portátil que usa Office de 64 bits y ocurre lo mismo, no basta cambiar la declaración de las funciones API de Windows. Me daré tiempo y lo revisaré bien, te aviso cuando encuentre como remediarlo.

Abraham Valencia

Hola,

Gracias por tu atención Abraham. Quedo atento a tu respuesta. :-)

[Hola estimado

Por fin me di tiempo de probar en Excel de 64 bits buscando soluciones, he de aceptar que aún no consigo el efecto ¿tú pudiste avanzar algo?

Abraham Valencia

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas