如何在自动打开时停止Excel工作簿闪烁？

Question

I'm using GetObject with a workbook path to either create a new or grab an existing Excel instance. If it's grabbing an existing user-created instance, the application window is visible; if the workbook path in question is closed, it will open and hide, but not before it flickers on the screen. Application.ScreenUpdating does not help with this.

I don't think I can use the Win32Api call LockWindowUpdate, because I don't know whether I'm getting or creating before the file is open. Is there some other VBA-friendly way (ie WinAPI) to freeze the screen long enough to get the object?

EDIT : Just to clarify, because the first answer suggests using the Application object... These are the steps to reproduce this behavior. 1. Open Excel--make sure you're only running one instance--save and close the default workbook. Excel window now visible but "empty" 2. Open Powerpoint or Word, insert a module, add the following code

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

1. Note the flicker as Excel opens the file in the existing instance, and then hides it... because it's automation
2. Note also, however, that there is no application object to work with, until the flickering is done. This is why I'm looking for some larger API method to "freeze" the screen.

Answer 1

Try,

Application.VBE.MainWindow.Visible = False

If that doesn't work try

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

Both found here Eliminating Screen Flicker During VBProject Code

Answer 2

I ended up basically ditching GetObject, because it wasn't granular enough, and wrote my own flickerless opener, with some inspiration from osknows and great code samples from here and here . Thought I would share it in case others found it useful. First the complete module

'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 (a.k.a. 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, e.g. 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

And then some sample/test code.

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

Hope someone else finds this useful.

Answer 3

Ok you didn't mention multiple instances... [1. Open Excel--make sure you're only running one instance ] :)

How about something like this.....

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