⚡
Excel マクロランチャーを作ろう！
Excelマクロを使うと様々な処理を自動化できます。しかしながら、デフォルトで用意されているマクロの実行方法はあまり使いやすくありません[1]。ショートカットは覚えるのが大変ですし、 Alt+F8 で開くダイアログも操作性に難があります。この記事では、マクロを実行のためのランチャーを作成します。成果物は GitHub に格納しています。
マクロランチャー
コマンド実行処理の実装
まずは入力されたコマンドの実行処理を作成しましょう。名前は TryRun で、次のことを行います。
- 入力をスペースで分割して、マクロ名/引数のリストを得る
- 現在アクティブなブックにそのマクロがあれば、実行して終了
- 個人用マクロブックにそのマクロがあれば、実行して終了
- マクロの実行に失敗したら、エラーダイアログを出す
今回はアクティブなブックと個人用マクロブック (PERSONAL.XLSB) にあるマクロの実行のみをサポートしています。
コマンドの実行
TryRun
Public Sub TryRun(cmd As String)
Dim src As Variant
Dim a As Variant
Dim m As String
' 1. 入力をスペースで分割して、マクロ名/引数のリストを得る
a = SplitToken(cmd)
If UBound(a) < 0 Then Exit Sub
' 2. 現在アクティブなブックにそのマクロがあれば、実行して終了
' 3. 個人用マクロブックにそのマクロがあれば、実行して終了
On Error Resume Next
For Each src In Array(ActiveWorkbook.Name, "PERSONAL.XLSB")
m = "'" & src & "'!" & a(0)
Select Case UBound(a)
Case 0: Run m
Case 1: Run m, a(1)
Case 2: Run m, a(1), a(2)
Case 3: Run m, a(1), a(2), a(3)
Case 4: Run m, a(1), a(2), a(3), a(4)
Case 5: Run m, a(1), a(2), a(3), a(4), a(5)
Case 6: Run m, a(1), a(2), a(3), a(4), a(5), a(6)
Case 7: Run m, a(1), a(2), a(3), a(4), a(5), a(6), a(7)
Case 8: Run m, a(1), a(2), a(3), a(4), a(5), a(6), a(7), a(8)
Case 9: Run m, a(1), a(2), a(3), a(4), a(5), a(6), a(7), a(8), a(9)
Case Else: MsgBox "Too many arguments (max 9).": Exit Sub
End Select
' 正常終了
If Err.Number = 0 Then Exit Sub
' 実行時エラー
' マクロが見つからないときのエラー (1004) を無視する
If Err.Number <> 1004 Then
MsgBox Err.Description
Exit Sub
Else
Err.Clear
End If
Next src
' 4. マクロの実行に失敗したら、エラーダイアログを出す
MsgBox "マクロの実行に失敗しました"
End Sub
トークン分割の際に連続したスペースを無視するのがちょっとした工夫です。
トークン分割
' 連続したスペースを無視して分割する。
' (単純に Split すると、"a b" が ["a", "", "b"] に分割されてしまう)
Private Function SplitToken(text As String) As Variant
Dim raw As Variant
Dim result() As String
Dim i As Long
Dim n As Long
raw = Split(Trim(text), " ")
If UBound(raw) < 0 Then
SplitToken = raw
Exit Function
End If
ReDim result(0 To UBound(raw))
For i = 0 To UBound(raw)
If Len(raw(i)) > 0 Then
result(n) = raw(i)
n = n + 1
End If
Next
ReDim Preserve result(0 To n - 1)
SplitToken = result
End Function
UI の実装
次にUIを作ります。フォームを作成し、入力欄と補完候補リストを配置します。位置やサイズは後からVBAで指定します。
適当に部品を配置する
フォームの初期化処理 (UserForm_Initialize) では、フォームを透過し、部品の位置とサイズを調整します。加えて、補完候補となるマクロ一覧を取得します。フォームの透過やマクロ一覧の取得については後述します。
フォームの初期化
Private Const MAX_ROWS As Long = 5 ' 補完の最大表示行数
Private Const ROW_HEIGHT As Long = 18 ' 補完候補の行高
Private CommandList As Variant ' マクロ一覧
Private Sub UserForm_Initialize()
' フォーム背景の透過
FormUtil.MakeFormTransparent Me
' 部品のプロパティを調整
With Me.TextBox1
.Font.Name = "MS Gothic"
.Font.Size = 18
.Top = 0
.Left = 0
.Width = WorksheetFunction.Min(360, ActiveWindow.Width * 0.7)
.Height = 24
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.BackColor = &HFFFFFF
End With
With Me.ListBox1
.IntegralHeight = False
.Font.Name = Me.TextBox1.Font.Name
.Font.Size = Me.TextBox1.Font.Size
.Left = Me.TextBox1.Left
.Top = Me.TextBox1.Top + Me.TextBox1.Height
.Width = Me.TextBox1.Width
.Height = MAX_ROWS * ROW_HEIGHT + 1
.BorderStyle = fmBorderStyleSingle
.SpecialEffect = fmSpecialEffectFlat
.BackColor = &HF0F0F0
.Visible = False
.Clear
End With
Me.Width = Me.TextBox1.Width
Me.Height = Me.TextBox1.Height + Me.ListBox1.Height
' マクロ一覧の取得
Set CommandList = Util.GetProcedureList
UpdateCandidates
End Sub
そして、イベント等に応じて補完候補の更新や反映をします。おおよそ次のような処理を行います。
| イベント | 行う処理 |
|---|---|
| 上下キーが押された | 補完候補を選択し、入力欄に反映 |
| 文字キーが押された | 補完候補を更新 |
| Enter が押された | コマンド実行 (TryRun を呼ぶ) |
| Esc が押された | フォームを閉じる |
イベントハンドラ
イベントハンドラ
Private Sub TextBox1_KeyDown( _
ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer _
)
' 候補選択
If KeyCode = vbKeyDown Or KeyCode = vbKeyUp Then
SelectCandidate IIf(KeyCode = vbKeyDown, 1, -1)
KeyCode = 0
Exit Sub
End If
If KeyCode = vbKeyTab Then
SelectCandidate IIf((Shift And 1) <> 0, -1, 1)
KeyCode = 0
Exit Sub
End If
' 選択解除
Me.ListBox1.ListIndex = -1
' 実行/キャンセル
If KeyCode = vbKeyReturn Or KeyCode = vbKeyEscape Then
If KeyCode = vbKeyReturn Then Core.TryRun Me.TextBox1.text
Unload Me
KeyCode = 0
Exit Sub
End If
End Sub
Private Sub TextBox1_Change()
If Me.ListBox1.ListIndex = -1 Then UpdateCandidates
End Sub
Private Sub SelectCandidate(idxDelta As Integer)
If Me.ListBox1.ListCount = 0 Then Exit Sub
' 選択対象の更新
With Me.ListBox1
.ListIndex = (.ListCount + .ListIndex + idxDelta) Mod .ListCount
End With
' 入力欄に選択対象を反映
With Me.TextBox1
.text = Me.ListBox1.List(Me.ListBox1.ListIndex)
.SelStart = Len(Me.TextBox1.text)
.SelLength = 0
End With
End Sub
Private Sub UpdateCandidates()
Dim cmd As Variant
Dim numShow As Long
Dim prefix As String
' 候補の取得
Me.ListBox1.Clear
prefix = LCase(Me.TextBox1.text) & "*"
For Each cmd In CommandList
If LCase(cmd) Like prefix Then Me.ListBox1.AddItem cmd
Next cmd
' 候補の表示
numShow = WorksheetFunction.Min(Me.ListBox1.ListCount, MAX_ROWS)
With Me.ListBox1
.Height = IIf(numShow > 0, numShow * ROW_HEIGHT + 1, 0)
.ListIndex = -1
.Visible = (numShow > 0)
End With
End Sub
フォームの透化 (MakeFormTransparent)
フォームの透化には Windows の API を利用します。タイトルバーや枠線を消し、フォームの背景色を透過することでフォーム上の部品のみが見えるようにします。
フォームの透過
Option Explicit
Option Private Module
Private Declare PtrSafe Function FindWindowA Lib "user32" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long
Private Declare PtrSafe Function GetWindowLongPtrA Lib "user32" ( _
ByVal hWnd As LongPtr, _
ByVal nIndex As Long _
) As LongPtr
Private Declare PtrSafe Function SetWindowLongPtrA Lib "user32" ( _
ByVal hWnd As LongPtr, _
ByVal nIndex As Long, _
ByVal dwNewLong As LongPtr _
) As LongPtr
Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" ( _
ByVal hWnd As LongPtr, _
ByVal crey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long _
) As Long
Private Const GWL_EXSTYLE As Long = -20
Private Const GWL_STYLE As Long = -16
Private Const WS_EX_LAYERED As Long = &H80000
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_CAPTION As Long = &HC00000
Private Const LWA_COLORKEY As Long = &H1
Public Sub MakeFormTransparent(frm As Object)
Dim hWnd As LongPtr
Dim style As LongPtr
hWnd = FindWindowA(vbNullString, frm.Caption)
If hWnd = 0 Then Exit Sub
' タイトルバーを消す
style = GetWindowLongPtrA(hWnd, GWL_STYLE)
style = style And Not WS_CAPTION
SetWindowLongPtrA hWnd, GWL_STYLE, style
' 枠線がなく、透過できるウィンドウにする
style = GetWindowLongPtrA(hWnd, GWL_EXSTYLE)
style = (style Or WS_EX_LAYERED) And Not WS_EX_DLGMODALFRAME
SetWindowLongPtrA hWnd, GWL_EXSTYLE, style
frm.BackColor = &HFF00FF
SetLayeredWindowAttributes hWnd, frm.BackColor, 0, LWA_COLORKEY
End Sub
マクロ一覧の取得
補完に利用するマクロ一覧を取得します。取得には VBIDE を利用するため、「トラスト センター > マクロの設定」より、「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」の有効化が必要です。
マクロ一覧の取得
マクロ一覧の取得
Option Explicit
Public Function GetProcedureList() As Collection
Dim procList As Collection
Set procList = New Collection
On Error Resume Next
EnumerateProcsInProject ActiveWorkbook.VBProject, procList
EnumerateProcsInProject Application.Workbooks("Personal.xlsb").VBProject, procList
On Error GoTo 0
Set GetProcedureList = procList
End Function
Private Sub EnumerateProcsInProject(ByVal vbProj As Object, ByVal procList As Collection)
Dim vbComp As Object
Dim codeMod As Object
Dim lineNum As Long
Dim procName As String
Dim procKind As Long
For Each vbComp In vbProj.VBComponents
Set codeMod = vbComp.CodeModule
lineNum = 1
Do While lineNum <= codeMod.CountOfLines
procName = codeMod.ProcOfLine(lineNum, procKind)
If procName = "" Then
lineNum = lineNum + 1
End If
procList.Add procName
lineNum = lineNum + codeMod.ProcCountLines(procName, procKind)
Loop
Next vbComp
End Sub
おまけ1 : より単純なUI
インプットボックスを使うとUI実装を単純化できます。
補完機能や見た目のシンプルさがこそありませんが、それらが不要なのであれば有力な選択肢でしょう。
インプットボックスを使う
Public Sub RunCmdWithInputBox()
Dim cmd As String
cmd = InputBox("実行するマクロを入力")
Core.TryRun cmd
End Sub
インプットボックスによるUI
おまけ2 : Vim風のUI
Excelのステータスバー (Application.StatusBar) を編集することで、Vimのコマンドライン領域のようなUIが作れます。見た目のシンプルさは随一です。今回は実装していませんが、上記のフォーム透化を応用すれば補完リストも表示できるでしょう。ただし、多くのキーバインドを編集する点に注意が必要です。VBAではキーに紐づいたプロシージャを特定できないため、一度バインドを編集すると元のバインドを復元することができません。
ステータスバーによるUI
| 状況 | イベント | 処理 | 処理後の状況 |
|---|---|---|---|
| 通常時 |
: が押された |
ランチャーを起動 | ランチャー起動時 |
| ランチャー起動時 | 文字キー/BSが押された | ステータスバーを更新 | ランチャー起動時 |
| ランチャー起動時 | Enter が押された | キーバインドを解除して TryRun を実行 |
通常時 |
マクロの実行にキーハンドラが影響しないよう、マクロの実行前にキーハンドラを解除するのがポイントです。
キーハンドラの登録
キー押下にイベントハンドラを割り当てます。これにより、英数字記号を押すと CmdHandleKey に押したキーの名前が送られるようになります。
Public Sub EnableOnKeyHandler()
SetOnKeyHandler "CmdHandleKey"
End Sub
Public Sub DisableOnKeyHandler()
SetOnKeyHandler ""
End Sub
Private Sub SetOnKeyHandler(handlerName As String)
Dim i As Integer
Dim handler As String
Dim ch As String
Dim keyStr As Variant
For i = Asc(" ") To Asc("~")
ch = Chr(i)
Select Case True
Case Asc("A") <= i And i <= Asc("Z"): keyStr = "+" & LCase(ch)
Case InStr("+^%*(){}[]", Chr$(i)) > 0: keyStr = "{" & ch & "}"
Case Else: keyStr = ch
End Select
handler = IIf(handlerName <> "", "'" & handlerName & " """ & ch & """'", "")
Application.OnKey keyStr, handler
Next i
For Each keyStr In Array("{BS}", "~", "{ESC}")
Application.OnKey keyStr, IIf(handlerName <> "", "'" & handlerName & " """ & keyStr & """'", "")
Next
End Sub
キーハンドラの実装
CmdHandleKey では入力をもとにステータスバーの表示内容を調整します。また、エンターキーが押されたらマクロを実行します。マクロを実行する前にはキーバインドを解除します。これは、デフォルトのキーバインドに依存したマクロを正しく実行するための処理です。
Private Buf As String
Private Sub ShowBuf()
Application.StatusBar = ":" & Buf & "|"
End Sub
Public Sub CmdHandleKey(key As String)
Select Case key
Case "~"
ExecuteCmd
Case "{ESC}"
ExitCmdMode
Case "{BS}"
If Len(Buf) = 0 Then
ExitCmdMode
Exit Sub
End If
Buf = Left(Buf, Len(Buf) - 1)
ShowBuf
Case Else
Buf = Buf & key
ShowBuf
End Select
End Sub
Private Sub ExecuteCmd()
On Error GoTo Cleanup
DisableOnKeyHandler
Core.TryRun Buf
Cleanup:
ExitCmdMode
End Sub
状態遷移
Public Sub EnterCmdMode()
EnableOnKeyHandler
Buf = ""
ShowBuf
End Sub
Private Sub ExitCmdMode()
DisableOnKeyHandler
Application.OnKey ":", "EnterCmdMode"
Application.StatusBar = ""
End Sub
おわりに
マクロは時短のための強力なツールですが、その実行にもたついてしまっては元も子もありません。本記事で紹介したランチャーを使えば、必要なマクロを素早く呼び出せます。みなさんも、マクロランチャーで快適なExcelライフを手に入れましょう！
-
個人の意見です ↩︎
Discussion