使用计时器获取Excel标题

时间:2013-09-15 13:55:15

标签: excel vb6

我有以下代码来获取当前打开的excel文件的标题,此代码正常工作。如果标题更改,我会每隔10秒使用一次计时器,然后在list1中添加新标题。

所以问题是有任何方法或事件来检测标题是否更改然后我的代码工作,否则它不工作不检查。如果我运行此代码,我的电脑工作每10秒钟定时检查

Private Const GW_HWNDNEXT = 2

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, _
ByVal wCmd As Long) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
(ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Sub ListWins(Optional Title = "*", Optional Class = "*")
    Dim hWndThis As Long

    hWndThis = FindWindow(vbNullString, vbNullString)

    While hWndThis
        Dim sTitle As String, sClass As String
        sTitle = Space$(255)
        sTitle = Left$(sTitle, GetWindowText(hWndThis, sTitle, Len(sTitle)))

        sClass = Space$(255)
        sClass = Left$(sClass, GetClassName(hWndThis, sClass, Len(sClass)))

        If sTitle Like Title And sClass Like Class Then
            Debug.Print sTitle, sClass
            List1.AddItem (sTitle)
        End If

        hWndThis = GetWindow(hWndThis, GW_HWNDNEXT)
    Wend
End Sub

Private Sub Timer1_Timer()
    ListWins "*.xls*"
End Sub

2 个答案:

答案 0 :(得分:0)

答案是No。 AFAIK,没有在vb6中没有这样的事件会在Excel或任何其他窗口中捕获标题更改。还不幸的是,10秒计时器可能不太好。如果标题每2秒更改一次会怎样?它不会检索所有标题

然而,试试这个不使用定时器控制的替代方案。看看你的电脑是否仍然很慢......

Sub Sample()
    '
    ' ~~> Rest of your code
    '

    Wait 2 '<~~ Wait for 2 seconds

    '
    ' ~~> Rest of your code
    '
End Sub

Private Sub Wait(ByVal nSec As Long)
    nSec = nSec + Timer
    While nSec > Timer
        DoEvents
    Wend
End Sub

答案 1 :(得分:0)

您可以使用Excel COM API执行此操作。不幸的是,没有办法获得Excel窗口标题 - 但您可以通过附加“ - Microsoft Excel”轻松制作它。如果需要完整路径,请使用FullName属性。

Option Explicit

Private WithEvents m_oApplication               As Excel.Application

Private Sub Command_Click()

    ' Get a reference to the FIRST instance of the Excel application.
    Set m_oApplication = GetObject(, "Excel.Application")

End Sub

Private Sub m_oApplication_NewWorkbook(ByVal Wb As Excel.Workbook)
    List1.AddItem Wb.Name
End Sub

Private Sub m_oApplication_WorkbookAfterSave(ByVal Wb As Excel.Workbook, ByVal Success As Boolean)
    'List1.AddItem "WorkbookAfterSave: " & Wb.FullName
    List1.AddItem Wb.Name
End Sub

Private Sub m_oApplication_WorkbookOpen(ByVal Wb As Excel.Workbook)
    List1.AddItem Wb.Name
End Sub