完美Excel

Private m_colContextMenus As Collection
 
Private Sub UserForm_Initialize()
 
    Dim clsContextMenu As CTextBox_ContextMenu
 
    Set m_colContextMenus = New Collection
 
    Set clsContextMenu = New CTextBox_ContextMenu
    With clsContextMenu
        Set .TBox = UserForm1.TextBox1
        Set .Parent = Me
    End With
    m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
 
    Set clsContextMenu = New CTextBox_ContextMenu
    With clsContextMenu
        Set .TBox = UserForm1.TextBox2
        Set .Parent = Me
    End With
    m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
 
    Set clsContextMenu = New CTextBox_ContextMenu
    With clsContextMenu
        Set .TBox = UserForm1.TextBox3
        Set .Parent = Me
    End With
    m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
 
    Set clsContextMenu = New CTextBox_ContextMenu
    With clsContextMenu
        Set .TBox = UserForm1.TextBox4
        Set .Parent = Me
    End With
    m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
 
    Set clsContextMenu = New CTextBox_ContextMenu
    With clsContextMenu
        Set .TBox = UserForm1.TextBox5
        Set .Parent = Me
    End With
    m_colContextMenus.Add clsContextMenu, CStr(m_colContextMenus.Count + 1)
 
End Sub

Public Declare Function SetTimer& Lib "user32" (ByVal hwnd&, _
    ByVal nIDEvent&, ByVal uElapse&, ByVal lpTimerFunc&)
Private Declare Function KillTimer& Lib "user32" (ByVal hwnd&, _
    ByVal nIDEvent&)
Public Const NV_INPUTBOX As Long = &H5000
 
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
    SendKeys "%Y"
    KillTimer hwnd, idEvent
End Sub
 
Sub test()
 
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
 
    Dim targetworkbook As Workbook
 
    Dim usersave As VbMsgBoxResult
 
    Set targetworkbook = Workbooks.Open("C:\test2.xls", UpdateLinks:=0)
 
    Calculate
    targetworkbook.Activate
    SetTimer 0, NV_INPUTBOX, 1000, AddressOf TimerProc
    Application.Run targetworkbook.Name & "!tester"
 
    targetworkbook.Activate
 
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
 
End Sub

Sub tester()
    TimedMsgBox
End Sub
 
Sub TimedMsgBox()
    Dim cTime As Long
    Dim WSH As Object
 
    Set WSH = CreateObject("WScript.Shell")
    cTime = 5 '5 秒
    Select Case WSH.Popup("Open an Excel file?!", cTime, "Question", vbOKCancel)
        Case vbOK
            MsgBox "你单击了确定"
        Case vbCancel
            MsgBox "你单击了取消"
        Case -1
            MsgBox "超时"
    End Select
End Sub

Private Sub lbxItem_Change()
    Dim rngCategory As Range
 
    Set rngCategory = Sheet1.Range(Me.lbxItem.Value)
 
    Me.lbxCategory.List = rngCategory.Value
End Sub
 
Private Sub UserForm_Initialize()
    Dim rngItem As Range
 
    Set rngItem = Sheet1.Range("项目")
 
    Me.lbxItem.List = rngItem.Value
End Sub