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

| 我正在使用带有工作簿路径的GetObject来创建新的或获取现有的Excel实例。如果它正在捕获现有的用户创建的实例，则该应用程序窗口可见；如果有问题的工作簿路径已关闭，它将打开和隐藏，但不会在屏幕上闪烁之前。 
Application.ScreenUpdating
无助于此。 我认为我无法使用Win32Api调用LockWindowUpdate，因为我不知道在打开文件之前是要获取还是正在创建。还有其他一些VBA友好方式（即WinAPI）将屏幕冻结足够长的时间以获取对象吗？ 编辑：只是为了澄清，因为第一个答案建议使用Application对象...这些是重现此行为的步骤。 1.打开Excel（确保仅运行一个实例），保存并关闭默认工作簿。 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方法来“冻结”屏幕的原因。     
2020-05-01 4 条评论
分享

没有找到相关结果

    已邀请:

    荆怖赡

    尝试， 
    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
    两者都在这里找到消除VBProject代码期间的屏幕闪烁     
    2020-05-01 0 0
    分享

    嘘崇蔡对

    我最终放弃了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 (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
    然后是一些样本/测试代码。 
    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
    希望其他人觉得这有用。     
    2020-05-01 0 0
    分享

    肺鬼耙扮群

    好的，您没有提到多个实例... [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
        
    2020-05-01 0 0
    分享
    为什么被折叠? 0 个回复被折叠

    要回复问题请先登录或注册

    或代码 OrCode.com 备案号：粤ICP备15020848号-1
    Escape time: 0.065268993377686