Excel VBA と VBScript で 自作アイコンとドラッグ&ドロップが出来るアプリケーションを作る
こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。
この記事の目次
背景・目的
小さなアプリケーションを Excel VBA で作っていると管理がめんどくさい!
使い勝手もいちいち Excel を起動して、ファイルやフォルダを選択して、ボタンを押すという動作さえわずらわしい!!
そして、作ったアプリが増えすぎてデスクトップのどこにあるかが分かりづらい!!!
これらの不満を出来る限り解決します。
この記事では印刷アプリケーションを作成します。
印刷したいファイルをドラッグ&ドロップすると『通常使うプリンタ』として設定されているプリンタでドロップしたファイルの印刷設定で印刷されるアプリケーションです。
下準備
アプリケーションフォルダの作成
図1の様に場所はどこでも良いので、フォルダを作ります。この時、フォルダの名前がアプリケーションの名前になります。
サブフォルダの作成
作成したフォルダの中にフォルダ2つとマクロ有効ブックを作成します。アイコンの作成
ペイントソフト
Windowsに元々インストールされている『ペイント』というソフトを使います。ペイントの画像のサイズ
画像のサイズを変更します。『アイコン 画像サイズ』でインターネット検索したところ、アイコンの画像サイズは『 24×24 』か『 32×32 』が多いらしいです。
今回は『 24×24 』 にします。
『サイズ変更』ボタンを押して、『サイズ変更と傾斜』ウィンドウを開きます。
サイズ変更ウィンドウの操作は以下の順番で行います。
①単位をピクセルにする
②『縦横比を維持する』のチェックを外す
③水平方向に『 24 』を入力する
④垂直方向に『 24 』を入力する
サイズ変更が出来ました。
ペイントの使い方
このままだと画像が小さすぎて、アイコンが作れないので、『表示』タブの『拡大』ボタンを押して、拡大します。800%まで拡大します。
何か文字を1文字書いてみます。
『 A 』ボタンを押します。
そして、アプリケーションをイメージ出来る1文字を入力します。
なぜか横向きになるので、縦向きに直します。
『選択』ボタンを押して、文字を囲みます。
『回転』ボタンを押して、文字を回転させて文字を横→縦にします。
アイコン化する時にショートカットを作成する都合で文字を画像右上に配置します。
アイコンの保存
保存がポイントです。ファイル名の最後に『.ico』とつけて、 ファイルの種類の『24 ビット ビットマップ』を選択して『保存』ボタンを押して、保存します。
プログラム
VBScript ソースコード
まず、VBScript を書きます。ファイルがドラッグ&ドロップされたら、画像かどうかを拡張子から判断して、印刷するVBScript です。
' 印刷出来るファイル
' .txt
' .pdf
' .xls
' .xlsx
' .ppt
' .pptx
' .doc
' .docx
' .msg
' .bat
' .vbs
' .png
' .jpg
' .bmp
' 印刷出来ないファイル
' .dat(パソコンの設定で Windows 標準の「メモ帳」では無く、サクラエディタで起動する設定のため InvokeVerbEx から印刷できない)
' .csv(パソコンの設定で Windows 標準の「メモ帳」では無く、サクラエディタで起動する設定のため InvokeVerbEx から印刷できない)
'-------------------------------------------------------------------------------------------------------
' 引数が無かった時の処理
'-------------------------------------------------------------------------------------------------------
If WScript.Arguments.count = 0 then
WScript.Echo "引数が無いため、実行できません。" & vbNewLine & _
"ファイルをドロップしてください。"
WScript.Quit
End If
'-------------------------------------------------------------------------------------------------------
' フォルダ内ファイルリスト出力
'-------------------------------------------------------------------------------------------------------
for each args In WScript.Arguments
'----------------------------------------------------------------------------------------------------
' ファイルシステムオブジェクト作成
'----------------------------------------------------------------------------------------------------
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'----------------------------------------------------------------------------------------------------
' ドロップされた引数がフォルダかファイルかを判定する
'----------------------------------------------------------------------------------------------------
If objFileSys.FolderExists(args) then
' is folder.
WScript.Echo "フォルダがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
ElseIf objFileSys.FileExists(args) then
' is file.
else
' is unknown.
WScript.Echo "フォルダ 及び ファイル とも認識できないデータがドロップされました。" & vbNewLine & _
"処理を終了します。"
WScript.Quit
End If
'----------------------------------------------------------------------------------------------------
' ドロップされた引数がフォルダか画像かを判定する
'----------------------------------------------------------------------------------------------------
Flag_Image = False
pos = InstrRev(args, ".")
argsExtension = Mid(args, pos)
Flag_Image = ImageDetermination(argsExtension)
'----------------------------------------------------------------------------------------------------
' ドロップされたファイルが画像以外なら
'----------------------------------------------------------------------------------------------------
If Flag_Image = False Then
'-------------------------------------------------------------------------------------------------
' シェルオブジェクト作成
'-------------------------------------------------------------------------------------------------
Set objWsh = WScript.CreateObject("Shell.Application")
'-------------------------------------------------------------------------------------------------
' 引数ファイルのパスの分解
'-------------------------------------------------------------------------------------------------
pos = InstrRev(args, "\")
Dir_Name = Left(args, pos - 1)
file_Name = Mid(args, pos + 1)
'-------------------------------------------------------------------------------------------------
' フォルダオブジェクト と ファイルオブジェクトの作成
'-------------------------------------------------------------------------------------------------
Set objFolder = objWsh.NameSpace(Dir_Name)
Set objFile = objFolder.ParseName(file_Name)
'Msgbox objFolder.Title & vbnewline & objFile.Name
'-------------------------------------------------------------------------------------------------
' 印刷する
'-------------------------------------------------------------------------------------------------
objFile.InvokeVerbEx("Print")
'-------------------------------------------------------------------------------------------------
' シェルオブジェクトの破棄
'-------------------------------------------------------------------------------------------------
Set objWsh = Nothing
'----------------------------------------------------------------------------------------------------
' ドロップされたファイルが画像なら
'----------------------------------------------------------------------------------------------------
Else
'-------------------------------------------------------------------------------------------------
' 印刷する
'-------------------------------------------------------------------------------------------------
Set objWsh = CreateObject("WScript.Shell")
objWsh.Run "mspaint.exe " & args & " /p"
Set objWsh = Nothing
End If
Next
'-------------------------------------------------------------------------------------------------------
' 画像ファイルかどうかの判定関数
'-------------------------------------------------------------------------------------------------------
Function ImageDetermination(argsExtension)
' 画像ファイルの拡張子を記憶
ImageExtension = Array(".jpg", ".jpeg", ".JPG", ".JPEG", ".jpe", ".jfif", ".pjpeg", ".pjp", _
".png", _
".gif", _
".svg", ".svgz", _
".bmp", ".dib")
' 画像判定ループ
For i = LBound(ImageExtension) To UBound(ImageExtension)
' 画像ファイルの拡張子と同一の拡張子であれば
If ImageExtension(i) = argsExtension Then
' 画像ファイルであると判断する
ImageDetermination = True
' 関数を終了する
Exit Function
' 画像ファイルの拡張子と不一致の拡張子であれば
Else
' 画像ファイル以外と判断する
ImageDetermination = False
End If
Next
End Function
VBScript の保存
VBScript は上のソースコードを『メモ帳』にコピペします。『名前を付けて保存』する時にファイル名の最後に『.vbs』を付けて、ファイル種類の『すべてのファイル』を選択して『保存』ボタンを押して保存します。
Excel の開発タブの表示
※ 既に開発タブが表示されている人は次の『VBAの作成』までスクロールして下さい。Excel を開きます。
ホームボタンから『Excelのオプション』をクリックします。
『基本設定』の『開発タブをリボンに表示する』にチェックを付けます。
開発タブが表示されました。
VBAの作成
開発タブを選択します。Visual Basic ボタンをクリックします。
Visual Basic Editor が起動します。
VBAソースコードを書き入れる場所を追加します。
『挿入』→『標準モジュール』
VBAソースコードを書き入れる場所が追加されました。
VBA ソースコード
VBA は使用環境を整えるために使います。シート上にインストールボタンを作成して、そのボタンを押すとデスクトップ画面に作成したアイコンでショートカットが作成されるVBAを書きます。
このソースコードは図24 のVBAソースコードを書き入れる場所にコピペして下さい。
Sub DeskTopShortcut()
Dim WSH, sc
Set WSH = CreateObject("WScript.Shell")
' ショートカットの名前設定
フォルダ名 = ThisWorkbook.Path
pos = InStrRev(フォルダ名, "\")
フォルダ名 = Mid(フォルダ名, pos + 1)
ショートカット名 = フォルダ名
myPath = WSH.SpecialFolders("Desktop") & "\" & ショートカット名 & "-ショートカット.lnk"
' ショートカット作成
Set sc = WSH.CreateShortcut(myPath)
' フォルダ内に保存されているファイルが1つであることを確認する
プログラムフォルダ = ThisWorkbook.Path & "\" & "Program"
CountFile = フォルダ内ファイルカウント(プログラムフォルダ)
If CountFile > 1 Then
MsgBox "プログラムフォルダ内にプログラムが複数確認されました。" & vbNewLine & _
"1つだけにして再度インストールして下さい。"
Exit Sub
ElseIf CountFile = 0 Then
MsgBox "プログラムフォルダ内にプログラムが確認出来ませんでした。" & vbNewLine & _
"プログラムフォルダに1つだけプログラムを保存して再度インストールして下さい。"
Exit Sub
End If
' フォルダ内に保存されているファイルが1つであることを確認する
アイコンフォルダ = ThisWorkbook.Path & "\" & "Icon"
CountFile = フォルダ内ファイルカウント(アイコンフォルダ)
If CountFile > 1 Then
MsgBox "アイコンフォルダ内にアイコンが複数確認されました。" & vbNewLine & _
"1つだけにして再度インストールして下さい。"
Exit Sub
ElseIf CountFile = 0 Then
MsgBox "アイコンフォルダ内にアイコンが確認出来ませんでした。" & vbNewLine & _
"アイコンフォルダに1つだけプログラムを保存して再度インストールして下さい。"
Exit Sub
End If
' ターゲットパスの設定
ファイル名 = フォルダ内ファイル取得(プログラムフォルダ)
sc.TargetPath = プログラムフォルダ & "\" & ファイル名(0)
' アイコンの設定
ファイル名 = フォルダ内ファイル取得(アイコンフォルダ)
sc.IconLocation = アイコンフォルダ & "\" & ファイル名(0)
' 設定保存
sc.Save
Set sc = Nothing
Set WSH = Nothing
End Sub
Function フォルダ内ファイルカウント(folderPath)
' カウント用変数
cnt = 0
' フォルダ内ファイル取得
buf = Dir(folderPath & "\" & "*.*")
' ファイルが無くなるまでループ
Do While buf <> ""
' ファイルカウント
cnt = cnt + 1
' フォルダ内ファイル更新
buf = Dir()
Loop
' 戻り値
フォルダ内ファイルカウント = cnt
End Function
Function フォルダ内ファイル取得(folderPath)
' ファイル名取得用変数
ファイル名 = ""
' フォルダ内ファイル取得
buf = Dir(folderPath & "\" & "*.*")
' ファイルが無くなるまでループ
Do While buf <> ""
' ファイル名の記憶
If ファイル名 = "" Then
ファイル名 = buf
Else
ファイル名 = ファイル名 & "@" & buf
End If
' フォルダ内ファイル更新
buf = Dir()
Loop
' ファイル名の配列化
ファイル名 = Split(ファイル名, "@")
' 戻り値
フォルダ内ファイル取得 = ファイル名
End Function
シート上にボタンを作る
『開発』タブの『デザインモード』ボタンを押します。『挿入』ボタンを押して『ActiveXコントロール』の『コマンドボタン』を押す。
シート上でドラッグしてボタンを作成する。
ボタンとVBAをリンクする
作成したボタンをダブルクリックします。ボタンのVBAソースコードを書き入れる場所(シートモジュール)にボタンが押された時に実行される中身が空っぽのプログラムが自動で書き込まれます。
ボタンが押された時に実行される中身が空っぽのプログラムで、上のVBAソースコードを呼び出す命令を書き入れます。
そして、上書き保存して、Visual Basic Editor を閉じます。
ボタンの作り込み
作成したボタンの上で右クリックする。右クリックメニューの『プロパティ』をクリックします。
プロパティウィンドウの『Accelerator』と『Caption』を変更する。
『Accelerator』はアルファベットを1文字入力します。
仮にアルファベットの『 A 』を入力したとすると、『 Alt + A 』でボタンが押せる様になります。
『Caption』はボタンに表示される文字列を入力します。
『Accelerator』に入力したアルファベットが入力されると自動で下線が着きます。
ボタンが完成しました。
あとはデザインモードボタンを押して、デザインモードを解除します。
コメント
Cドライブに『自作アプリ』などのフォルダを作成しておいて、作成したアプリケーションを『自作アプリ』フォルダに入れて、インストールしましょう。
自作アプリは『自作アプリ』フォルダの中に集約され、VBScript で作成したプログラムは簡単にドラッグ&ドロップ機能を組み込めるので、わずらわしい操作を排除できます。
また、アイコンもアプリケーション毎に付けられるので、デスクトップ画面でもなんのアプリがどこにあるのかが分かりやすくなります。
今回作成した印刷アプリでは無くて Excel 操作の必要なアプリケーションだとしても、VBScript から Excel VBA を呼び出す事も出来ます。もちろん他の exe ファイルなんかも VBScript から呼び出せます。
VBScript から呼び出さなくてもショートカットさえ作れるならプログラムを作る言語は何でも良いです。
社内配布などした時にもわりと受け入れられやすそうなアプリケーションになったのでは無いでしょうか。
以上