'ステータスバーを右クリックするマクロ(Excel95/97)

'テストはしましたが、状況によっては Excel の強制終了があるかもしれません。
'自己責任で使用してください。

'Excel 97 では、シート名の一覧は組み込みのメニューにあり、VBA で表示できます。
'また、ツールバーを右クリックするには、Alt キー等でコマンドバーをフォーカスし
'Shift + F10 を押すという方法もあります。

Option Explicit

Const WM_RBUTTONDOWN = &h204
Const WM_RBUTTONUP = &h205

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Declare Function GetClientRect Lib "user32" ( _
    ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Declare Function GetWindowRect Lib "user32" ( _
    ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Declare Function FindWindowEx2 Lib "user32" Alias "FindWindowExA" ( _
    ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
    ByVal hwnd As Long, ByVal uMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long


Sub StatusBar_RightClick()
    Dim iVersion As Single
    Dim hwnd As Long
    Dim rc As RECT
    Dim lParam As Long
    Dim iRet As Long

    iVersion = Int(MyVal(Application.Version))
    If iVersion = 7 Then
        hwnd = FindWindow("XLMAIN", Application.Caption)
        hwnd = FindWindowEx(hwnd, 0, "EXCEL8", "")
    ElseIf iVersion = 8 Then
        hwnd = FindWindow("XLMAIN", Application.Caption)
        hwnd = FindWindowEx(hwnd, 0, "EXCEL4", "")
    Else
        Exit Sub
    End If

    If hwnd = 0 Then Exit Sub
    iRet = GetClientRect(hwnd, rc)
    If iRet = 0 Then Exit Sub
    lParam = (rc.Bottom \ 2) * &h10000 + (rc.Right \ 2)
    iRet = PostMessage(hwnd, WM_RBUTTONDOWN, 0, lParam)
    iRet = PostMessage(hwnd, WM_RBUTTONUP, 0, lParam)
End Sub


Sub SheetScrollBar_RightClick()
    Dim iVersion As Single
    Dim hwnd As Long
    Dim rc As RECT
    Dim lParam As Long
    Dim iRet As Long
    Dim obj As Object

    iRet = 0
    For Each obj In Application.Windows
        If obj.Visible Then
            iRet = 1
            Exit For
        End If
    Next
    If iRet = 0 Then Exit Sub

    iVersion = Int(MyVal(Application.Version))
    If iVersion = 7 Then
        hwnd = FindWindow("XLMAIN", Application.Caption)
        hwnd = FindWindowEx(hwnd, 0, "XLDESK", "")
        hwnd = FindWindowEx2(hwnd, 0, "EXCEL9", 0&)
    ElseIf iVersion = 8 Then
        hwnd = FindWindow("XLMAIN", Application.Caption)
        hwnd = FindWindowEx(hwnd, 0, "XLDESK", "")
        hwnd = FindWindowEx2(hwnd, 0, "EXCEL7", 0&)
    Else
        Exit Sub
    End If

    If hwnd = 0 Then Exit Sub
    iRet = GetClientRect(hwnd, rc)
    If iRet = 0 Then Exit Sub
    lParam = (rc.Bottom - 5) * &h10000 + 5
    iRet = PostMessage(hwnd, WM_RBUTTONDOWN, 0, lParam)
    iRet = PostMessage(hwnd, WM_RBUTTONUP, 0, lParam)
End Sub


Sub Toolbar_RightClick()
    Dim iVersion As Single
    Dim hwnd As Long
    Dim hwnd2 As Long
    Dim iVisibleCount As Integer
    Dim iFixedCount As Integer
    Dim rc As RECT
    Dim lParam As Long
    Dim iRet As Long
    Dim obj As Object

    iVersion = Int(MyVal(Application.Version))
    If iVersion = 7 Then
        iVisibleCount = 0
        iFixedCount = 0
        For Each obj In Application.Toolbars
            If obj.Visible Then
                iVisibleCount = iVisibleCount + 1
                If obj.Position <> xlFloating Then
                    iFixedCount = iFixedCount + 1
                End If
            End If
        Next
        If iVisibleCount = 0 Then Exit Sub
        hwnd = FindWindow("XLMAIN", Application.Caption)
        If iFixedCount = 0 Then
            hwnd = FindWindowEx(hwnd, 0, "EXCEL3", "")
        Else
            hwnd2 = FindWindowEx(hwnd, 0, "EXCEL4", "")
            hwnd = FindWindowEx(hwnd, hwnd2, "EXCEL4", "")
        End If
    ElseIf iVersion = 8 Then
        hwnd = FindWindow("XLMAIN", Application.Caption)
        hwnd = FindWindowEx2(hwnd, 0, "EXCEL2", 0&)
    Else
        Exit Sub
    End If

    If hwnd = 0 Then Exit Sub
    iRet = GetClientRect(hwnd, rc)
    If iRet = 0 Then Exit Sub
    lParam = (rc.Bottom \ 2) * &h10000 + (rc.Right \ 2)
    iRet = PostMessage(hwnd, WM_RBUTTONDOWN, 0, lParam)
    iRet = PostMessage(hwnd, WM_RBUTTONUP, 0, lParam)
End Sub


Private Function MyVal(sNumber As String) As Double
    Dim sNumber2 As String
    Dim bFlag As Boolean
    Dim i As Integer
    MyVal = 0
    bFlag = False
    For i = 1 To Len(sNumber)
        Select Case Mid(sNumber, i, 1)
            Case "0" To "9"
            Case "."
                If bFlag Then
                    Exit For
                End If
                bFlag = True
            Case Else
                Exit For
        End Select
    Next
    If i > 1 Then
        sNumber2 = Left(sNumber, i - 1)
        If IsNumeric(sNumber2) Then
            MyVal = CDbl(sNumber2)
        End If
    End If
End Function