如何停止自动打开Excel工作簿闪烁？
我正在使用工作簿path的GetObject来创build一个新的或抓住现有的Excel实例。 如果抓取现有的用户创build的实例，应用程序窗口是可见的; 如果问题的工作簿path已closures，则会打开并隐藏，但不会在屏幕上闪烁。 Application.ScreenUpdating没有帮助。
我不认为我可以使用Win32Api调用LockWindowUpdate，因为我不知道我得到或创build文件之前打开。 是否有一些其他的VBA友好的方式（即WinAPI）冻结屏幕足够长的时间来获取对象？
编辑 ：只是为了澄清，因为第一个答案build议使用应用程序对象…这些是重现此行为的步骤。 1.打开Excel – 确保只运行一个实例 – 保存并closures默认工作簿。 Excel窗口现在可见但“空”2.打开Powerpoint或Word，插入一个模块，添加下面的代码
Public Sub Open_SomeWorkbook() Dim MyObj As Object Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'uncomment the next line to see the workbook again' 'MyObj.Parent.Windows(MyObj.Name).Visible = True' 'here's how you work with the application object... after the fact' Debug.Print MyObj.Parent.Version End Sub
- 注意闪烁，因为Excel在现有实例中打开文件，然后隐藏它，因为它是自动化的
- 但是请注意，在闪烁完成之前，没有应用程序对象可以使用。 这就是为什么我正在寻找一些更大的API方法来“冻结”屏幕。
尝试，
Application.VBE.MainWindow.Visible = False
如果这不起作用
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal ClassName As String, ByVal WindowName As String) As Long Private Declare Function LockWindowUpdate Lib "user32" _ (ByVal hWndLock As Long) As Long Sub EliminateScreenFlicker() Dim VBEHwnd As Long On Error GoTo ErrH: Application.VBE.MainWindow.Visible = False VBEHwnd = FindWindow("wndclass_desked_gsk", _ Application.VBE.MainWindow.Caption) If VBEHwnd Then LockWindowUpdate VBEHwnd End If ''''''''''''''''''''''''' ' your code here ''''''''''''''''''''''''' Application.VBE.MainWindow.Visible = False ErrH: LockWindowUpdate 0& End Sub
这两个在这里find消除屏幕闪烁在VBProject代码
好吧，你没有提到多个实例… [1。 打开Excel – 确保你只运行一个实例 ] 🙂
怎么样这样的事情…..
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" _ (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal lHwnd As Long, _ ByVal lCmdShow As Long) As Boolean Public Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long Sub GetWindowHandle() Const SW_HIDE As Long = 0 Const SW_SHOW As Long = 5 Const SW_MINIMIZE As Long = 2 Const SW_MAXIMIZE As Long = 3 'Const C_WINDOW_CLASS = "XLMAIN" Const C_WINDOW_CLASS = vbNullString Const C_FILE_NAME = "Microsoft Excel - Flickerbook.xlsx" 'Const C_FILE_NAME = vbNullString Dim xlHwnd As Long xlHwnd = FindWindow(lpClassName:=C_WINDOW_CLASS, _ lpWindowName:=C_FILE_NAME) 'Debug.Print xlHwnd if xlHwnd = 0 then Dim MyObj As Object Dim objExcel As Excel.Application Set objExcel = GetObject(, "Excel.Application") objExcel.ScreenUpdating = False Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'uncomment the next line to see the workbook again' 'MyObj.Parent.Windows(MyObj.Name).Visible = True 'here's how you work with the application object... after the fact' Debug.Print MyObj.Parent.Version MyObj.Close objExcel.ScreenUpdating = True else 'Either HIDE/SHOW or MINIMIZE/MAXIMISE ShowWindow xlHwnd, SW_HIDE Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'manage MyObj ShowWindow xlHwnd, SW_SHOW 'Or LockWindowUpdate then Unlock LockWindowUpdate xlHwnd Set MyObj = GetObject("C:\temp\MyFlickerbook.xlsx") 'manage MyObj LockWindowUpdate 0 end if ' 'Get Window Name ' Dim strWindowTitle As String ' strWindowTitle = Space(260) ' We must allocate a buffer for the GetWindowText function ' Call GetWindowText(xlHwnd, strWindowTitle, 260) ' debug.print (strWindowTitle) End Sub
我最终基本上放弃了GetObject，因为它不够精细，写了我自己的无闪烁的开瓶器，从osknows和从这里和这里伟大的代码示例的一些灵感。 以为我会分享它，以防其他人发现它有用。 首先是完整的模块
'looping through, parent and child (see also callbacks for lpEnumFunc) Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As Long, _ ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long 'title of window Private Declare Function GetWindowTextLength Lib "user32.dll" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, _ ByVal lpString As String, _ ByVal cch As Long) As Long 'class of window object Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long 'control window display Private Declare Function ShowWindow Lib "user32" (ByVal lHwnd As Long, _ ByVal lCmdShow As Long) As Boolean Private Declare Function BringWindowToTop Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long Public Enum swcShowWindowCmd swcHide = 0 swcNormal = 1 swcMinimized = 2 'but activated swcMaximized = 3 swcNormalNoActivate = 4 swcShow = 5 swcMinimize = 6 'activates next swcMinimizeNoActivate = 7 swcShowNoActive = 8 swcRestore = 9 swcShowDefault = 10 swcForceMinimized = 11 End Enum 'get application object using accessibility Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, _ ByVal dwId As Long, _ ByRef riid As GUID, _ ByRef ppvObject As Object) _ As Long Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, _ ByRef lpiid As GUID) As Long 'Const defined in winuser.h Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0 'IDispath pointer to native object model Private Const Guid_Excel As String = "{00020400-0000-0000-C000-000000000046}" Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type 'class names to search by (Excel, in this example, is XLMAIN) Private mstrAppClass As String 'title (aka pathless filename) to search for Private mstrFindTitle As String 'resulting handle outputs - "default" app instance and child with object Private mlngFirstHwnd As Long Private mlngChildHwnd As Long '------ 'replacement GetObject '------ Public Function GetExcelWbk(pstrFullName As String, _ Optional pbleShow As Boolean = False, _ Optional pbleWasOpenOutput As Boolean) As Object Dim XLApp As Object Dim xlWbk As Object Dim strWbkNameOnly As String Set XLApp = GetExcelAppForWbkPath(pstrFullName, pbleWasOpenOutput) 'other stuff can be done here if the app needs to be prepared for the load If pbleWasOpenOutput = False Then 'load it, without flicker, if you plan to show it If pbleShow = False Then XLApp.ScreenUpdating = False End If Set xlWbk = XLApp.Workbooks.Open(pstrFullName) Else 'get it by its (pathless, if saved) name strWbkNameOnly = PathOrFileNm("FileNm", pstrFullName) Set xlWbk = XLApp.Workbooks(strWbkNameOnly) End If Set GetExcelWbk = xlWbk Set xlWbk = Nothing Set XLApp = Nothing End Function Private Function GetExcelAppForWbkPath(pstrFullName As String, _ pbleWbkWasOpenOutput As Boolean, _ Optional pbleLoadAddIns As Boolean = True) As Object Dim XLApp As Object Dim bleAppRunning As Boolean Dim lngHwnd As Long 'get a handle, and determine whether it's for a workbook or an app instance lngHwnd = WbkOrFirstAppHandle(pstrFullName, pbleWbkWasOpenOutput) 'if a handle came back, at least one instance of Excel is running '(this isnt' particularly useful; just check XLApp.Visible when you're done getting/opening; 'if it's a hidden instance, it wasn't running) bleAppRunning = (lngHwnd > 0) 'get an app instance. Set XLApp = GetAppForHwnd(lngHwnd, pbleWbkWasOpenOutput, pbleLoadAddIns) Set GetExcelAppForWbkPath = XLApp Set XLApp = Nothing Exit Function End Function Private Function WbkOrFirstAppHandle(pstrFullName As String, _ pbleIsChildWindowOutput As Boolean) As Long Dim retval As Long 'defaults mstrAppClass = "XLMAIN" mstrFindTitle = PathOrFileNm("FileNm", pstrFullName) mlngFirstHwnd = 0 mlngChildHwnd = 0 'find retval = EnumWindows(AddressOf EnumWindowsProc, 0) If mlngChildHwnd > 0 Then pbleIsChildWindowOutput = True WbkOrFirstAppHandle = mlngChildHwnd Else WbkOrFirstAppHandle = mlngFirstHwnd End If 'clear mstrAppClass = "" mstrFindTitle = "" mlngFirstHwnd = 0 mlngChildHwnd = 0 End Function Private Function GetAppForHwnd(plngHWnd As Long, _ pbleIsChild As Boolean, _ pbleLoadAddIns As Boolean) As Object On Error GoTo HandleError Dim XLApp As Object Dim AI As Object If plngHWnd > 0 Then If pbleIsChild = True Then 'get the parent instance using accessibility Set XLApp = GetExcelAppForHwnd(plngHWnd) Else 'get the "default" instance Set XLApp = GetObject(, "Excel.Application") End If Else 'no Excel running Set XLApp = CreateObject("Excel.Application") If pbleLoadAddIns = True Then 'explicitly reload add-ins (automation doesn't) For Each AI In XLApp.AddIns If AI.Installed Then AI.Installed = False AI.Installed = True End If Next AI End If End If Set GetAppForHwnd = XLApp Set AI = Nothing Set XLApp = Nothing Exit Function End Function '------ 'API wrappers and utilities '------ Public Function uWindowClass(ByVal hWnd As Long) As String Dim strBuffer As String Dim retval As Long strBuffer = Space(256) retval = GetClassName(hWnd, strBuffer, 255) uWindowClass = Left(strBuffer, retval) End Function Public Function uWindowTitle(ByVal hWnd As Long) As String Dim lngLen As Long Dim strBuffer As String Dim retval As Long lngLen = GetWindowTextLength(hWnd) + 1 If lngLen > 1 Then 'title found - pad buffer strBuffer = Space(lngLen) '...get titlebar text retval = GetWindowText(hWnd, strBuffer, lngLen) uWindowTitle = Left(strBuffer, lngLen - 1) End If End Function Public Sub uShowWindow(ByVal hWnd As Long, _ Optional pShowType As swcShowWindowCmd = swcRestore) Dim retval As Long retval = ShowWindow(hWnd, pShowType) Select Case pShowType Case swcMaximized, swcNormal, swcRestore, swcShow BringWindowToTop hWnd SetFocus hWnd End Select End Sub Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim strThisClass As String Dim strThisTitle As String Dim retval As Long Dim bleMatch As Boolean 'mlngWinCounter = mlngWinCounter + 1 'type of window is all you need for parent strThisClass = uWindowClass(hWnd) bleMatch = (strThisClass = mstrAppClass) If bleMatch = True Then strThisTitle = uWindowTitle(hWnd) 'Debug.Print "Window #"; mlngWinCounter; " : "; 'Debug.Print strThisTitle; "(" & strThisClass & ") " & hWnd If mlngFirstHwnd = 0 Then mlngFirstHwnd = hWnd 'mlngChildWinCounter 0 retval = EnumChildWindows(hWnd, AddressOf EnumChildProc, 0) If mlngChildHwnd > 0 Then 'If mbleFindAll = False And mlngChildHwnd > 0 Then 'stop EnumWindows by setting result to 0 EnumWindowsProc = 0 Else EnumWindowsProc = 1 End If Else EnumWindowsProc = 1 End If End Function Private Function EnumChildProc(ByVal hWnd As Long, ByVal lParam As Long) As Long Dim strThisClass As String Dim strThisTitle As String Dim retval As Long Dim bleMatch As Boolean strThisClass = uWindowClass(hWnd) strThisTitle = uWindowTitle(hWnd) If Len(mstrFindTitle) > 0 Then bleMatch = (strThisTitle = mstrFindTitle) Else bleMatch = True End If If bleMatch = True Then mlngChildHwnd = hWnd EnumChildProc = 0 Else EnumChildProc = 1 End If End Function Public Function GetExcelAppForHwnd(pChildHwnd As Long) As Object Dim o As Object Dim g As GUID Dim retval As Long 'for child objects only, eg must use a loaded workbook to get its parent Excel.Application 'make a valid GUID type retval = IIDFromString(StrPtr(Guid_Excel), g) 'get retval = AccessibleObjectFromWindow(pChildHwnd, OBJID_NATIVEOM, g, o) If retval >= 0 Then Set GetExcelAppForHwnd = o.Application End If End Function Public Function PathOrFileNm(pstrPathOrFileNm As String, _ pstrFileNmWithPath As String) On Error GoTo HandleError Dim i As Integer Dim j As Integer Dim strChar As String If Len(pstrFileNmWithPath) > 0 Then i = InStrRev(pstrFileNmWithPath, "\") If i = 0 Then i = InStrRev(pstrFileNmWithPath, "/") End If If i > 0 Then Select Case pstrPathOrFileNm Case "Path" PathOrFileNm = Left(pstrFileNmWithPath, i - 1) Case "FileNm" PathOrFileNm = Mid(pstrFileNmWithPath, i + 1) End Select ElseIf pstrPathOrFileNm = "FileNm" Then PathOrFileNm = pstrFileNmWithPath End If End If End Function
然后是一些样本/testing代码。
Public Sub Test_GetExcelWbk() Dim MyXLApp As Object Dim MyXLWbk As Object Dim bleXLWasRunning As Boolean Dim bleWasOpen As Boolean Const TESTPATH As String = "C:\temp\MyFlickerbook.xlsx" Const SHOWONLOAD As Boolean = False Set MyXLWbk = GetExcelWbk(TESTPATH, SHOWONLOAD, bleWasOpen) If Not (MyXLWbk Is Nothing) Then Set MyXLApp = MyXLWbk.Parent bleXLWasRunning = MyXLApp.Visible If SHOWONLOAD = False Then If MsgBox("Show " & TESTPATH & "?", vbOKCancel) = vbOK Then MyXLApp.Visible = True MyXLApp.Windows(MyXLWbk.Name).Visible = True End If End If If bleWasOpen = False Then If MsgBox("Close " & TESTPATH & "?", vbOKCancel) = vbOK Then MyXLWbk.Close SaveChanges:=False If bleXLWasRunning = False Then MyXLApp.Quit End If End If End If End If Set MyXLWbk = Nothing Set MyXLApp = Nothing End Sub
希望别人认为这个有用。