コマンド入力

Excel上でショートカットキー実行後にコマンドを入力すると、設定していたマクロを実行する仕組みの一例。
サンプルブックをアップしたかったがアップする方法が分らなかった。別の場所にアップしておいてリンクを貼ることにする。

  • オブジェクト名「ActionSheet」「ShortSheet」というシートを用意(シート名はなんでも良い。)
  • 下記マクロを適切な箇所に貼り付ける

これでとりあえず動く。と思われる。

コマンドとマクロの対応表にて、コマンド「s」にマクロ「CommonModule.ExecShell」を割り当て、短縮表現と正式表現の対応表にて、短縮表現「n」に正式表現「"notepad"」を割り当てておくと「Alt + x」「s n」と入力することでメモ帳が立ち上がるようになる。

コマンド「o」にマクロ「CommonModule.OpenFolder」を割り当て、短縮表現「sys」に「"C:\WINDOWS\system32"」を割り当てておくと「Alt + x」「o sys」と入力することで explorer で system32 フォルダを開く。


ThisWorkBook

Option Explicit
 
Private Const X_CAPTION As String = "x(&x)"
 
Private Sub Workbook_Open()
 
    Call DeleteMenu
    Call CreateMenu
 
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
    Call DeleteMenu
     
End Sub
 
Private Sub CreateMenu()
 
    Dim MenuItem As Variant
    Set MenuItem = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup)
    MenuItem.Caption = X_CAPTION
    MenuItem.OnAction = "Command"
    MenuItem.BeginGroup = True
 
End Sub
 
Private Sub DeleteMenu()
 
    Dim Item As Variant
    For Each Item In Application.CommandBars("Worksheet Menu Bar").Controls
        If Item.Caption = X_CAPTION Then
            Item.Delete
        End If
    Next
 
End Sub

CommandModule

Option Explicit

Public Type ActionType
    Command As String
    Action As String
End Type
Public Actions() As ActionType

Public Type ShortType
    Short As String
    Full As String
End Type
Public Shorts() As ShortType

' コマンドを入力/実行する
Public Sub Command()

    Dim CommandText As String
    CommandText = InputBox("x")
    If CommandText = "" Then Exit Sub
    
    ' トークン分割
    Dim Commands() As String
    Commands = Split(CommandText, " ")
    
    ' コマンドと引数に分ける
    Dim i As Long, j As Long
    Dim Command As String
    Dim Args() As String
    
    Command = Commands(0)
    If UBound(Commands) = 0 Then
        ReDim Args(0)
    Else
        ReDim Args(UBound(Commands) - 1)
        For i = 0 To UBound(Args)
            Args(i) = Commands(i + 1)
        Next
    End If
    
    ' 短縮表現を正式表現に置換する
    Call GetShortList
    For i = 0 To UBound(Args)
        For j = 0 To UBound(Shorts)
            If Args(i) = Shorts(j).Short Then
                Args(i) = Shorts(j).Full
                Exit For
            End If
        Next
    Next
    
    ' コマンドに対応する処理があれば実行する
    Call GetActionList
    For i = 0 To UBound(Actions)
        If Command = Actions(i).Command Then
            If Args(0) = "" Then
                Call Application.Run(Actions(i).Action)
            Else
                Call Application.Run(Actions(i).Action, Args)
            End If
            Exit For
        End If
    Next

End Sub

' アクションリストを取得する
Private Sub GetActionList()

    ' 配列初期化
    ReDim Actions(63)

    ' 最終行取得
    Dim EndRow As Long
    EndRow = ActionSheet.Cells(65536, 1).End(xlUp).Row

    ' 全行探索
    Dim Row As Long
    Dim Count As Long
    For Row = 2 To EndRow
        ' カウントアップと配列調整
        Count = Count + 1
        If Count > UBound(Actions) Then
            ReDim Preserve Actions(Count * 2 - 1)
        End If
        
        ' コマンドと対応するアクションを取得
        Actions(Count - 1).Command = ActionSheet.Cells(Row, 1).Text
        Actions(Count - 1).Action = ActionSheet.Cells(Row, 2).Text
    Next

    ' 配列調整
    ReDim Preserve Actions(Count - 1)

End Sub

' 省略リストを取得する
Private Sub GetShortList()

    ' 配列初期化
    ReDim Shorts(63)

    ' 最終行取得
    Dim EndRow As Long
    EndRow = ShortSheet.Cells(65536, 1).End(xlUp).Row

    ' 全行探索
    Dim Row As Long
    Dim Count As Long
    For Row = 2 To EndRow
        ' カウントアップと配列調整
        Count = Count + 1
        If Count > UBound(Shorts) Then
            ReDim Preserve Shorts(Count * 2 - 1)
        End If
        
        ' コマンドと対応するアクションを取得
        Shorts(Count - 1).Short = ShortSheet.Cells(Row, 1).Text
        Shorts(Count - 1).Full = ShortSheet.Cells(Row, 2).Text
    Next

    ' 配列調整
    ReDim Preserve Shorts(Count - 1)

End Sub

CommonModule

Option Explicit

' 外部コマンドを実行する
Public Function ExecShell(ByRef Args() As String) As Boolean

    Call Shell(Join(Args, " "), vbNormalFocus)

End Function

' 指定フォルダを開く
Public Function OpenFile(ByRef Args() As String) As Boolean

    Call Shell("explorer " & Args(0), vbNormalFocus)

End Function

  • 最終更新:2012-12-04 12:40:37

このWIKIを編集するにはパスワード入力が必要です

認証パスワード