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
[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,
- Compartir respuesta