コマンド入力
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