解析エンジニアの自動化 blog

コツコツと自動化した方法を残す blog

Excel VBA と VBScript で 自作アイコンとドラッグ&ドロップが出来るアプリケーションを作る



こんにちは。
仕事の自動化にやりがいと達成感を感じるガッくんです。


この記事の目次



背景・目的


小さなアプリケーションを Excel VBA で作っていると管理がめんどくさい!

使い勝手もいちいち Excel を起動して、ファイルやフォルダを選択して、ボタンを押すという動作さえわずらわしい!!

そして、作ったアプリが増えすぎてデスクトップのどこにあるかが分かりづらい!!!

これらの不満を出来る限り解決します。

この記事では印刷アプリケーションを作成します。
印刷したいファイルをドラッグ&ドロップすると『通常使うプリンタ』として設定されているプリンタでドロップしたファイルの印刷設定で印刷されるアプリケーションです。



動作環境


Windows 7
Excel 2007
Windows Scripting Host



下準備

アプリケーションフォルダの作成

図1の様に場所はどこでも良いので、フォルダを作ります。
この時、フォルダの名前がアプリケーションの名前になります。


図1 アプリケーションフォルダ


サブフォルダの作成

作成したフォルダの中にフォルダ2つとマクロ有効ブックを作成します。


図2 サブフォルダとマクロ有効ブック

アイコンの作成

ペイントソフト

Windowsに元々インストールされている『ペイント』というソフトを使います。


図3 ペイントを起動したところ


ペイントの画像のサイズ

画像のサイズを変更します。
『アイコン 画像サイズ』でインターネット検索したところ、アイコンの画像サイズは『 24×24 』か『 32×32 』が多いらしいです。
今回は『 24×24 』 にします。
『サイズ変更』ボタンを押して、『サイズ変更と傾斜』ウィンドウを開きます。


図4 サイズ変更ウィンドウ


サイズ変更ウィンドウの操作は以下の順番で行います。
①単位をピクセルにする
②『縦横比を維持する』のチェックを外す
③水平方向に『 24 』を入力する
④垂直方向に『 24 』を入力する


図5 サイズ変更操作


サイズ変更が出来ました。


図6 サイズ変更した画像


ペイントの使い方

このままだと画像が小さすぎて、アイコンが作れないので、『表示』タブの『拡大』ボタンを押して、拡大します。


図7 画像の拡大


800%まで拡大します。


図8 拡大したところ


何か文字を1文字書いてみます。
『 A 』ボタンを押します。
そして、アプリケーションをイメージ出来る1文字を入力します。

図9 A ボタンを押す


図10 文字を書く


なぜか横向きになるので、縦向きに直します。
『選択』ボタンを押して、文字を囲みます。

図11 文字の選択


『回転』ボタンを押して、文字を回転させて文字を横→縦にします。
アイコン化する時にショートカットを作成する都合で文字を画像右上に配置します。

図12 文字の回転


図13 文字を右上に配置


アイコンの保存

保存がポイントです。
ファイル名の最後に『.ico』とつけて、 ファイルの種類の『24 ビット ビットマップ』を選択して『保存』ボタンを押して、保存します。

図14 アイコンの保存

プログラム

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』を付けて、ファイル種類の『すべてのファイル』を選択して『保存』ボタンを押して保存します。

図15 VBScript の保存


Excel の開発タブの表示

※ 既に開発タブが表示されている人は次の『VBAの作成』までスクロールして下さい。

Excel を開きます。

図16 Excel 画面


ホームボタンから『Excelのオプション』をクリックします。

図17 Excel のオプション


『基本設定』の『開発タブをリボンに表示する』にチェックを付けます。

図18 開発タブの表示設定


開発タブが表示されました。

図19 開発タブの表示設定


VBAの作成

開発タブを選択します。

図20 開発タブ


Visual Basic ボタンをクリックします。

図21 Visual Basic ボタン


Visual Basic Editor が起動します。

図22 VBE 画面


VBAソースコードを書き入れる場所を追加します。
『挿入』→『標準モジュール』

図23 標準モジュール追加


VBAソースコードを書き入れる場所が追加されました。

図24 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


シート上にボタンを作る

『開発』タブの『デザインモード』ボタンを押します。

図25 デザインモード


『挿入』ボタンを押して『ActiveXコントロール』の『コマンドボタン』を押す。

図26 ボタン作成


シート上でドラッグしてボタンを作成する。

図27 ボタン作成


ボタンとVBAをリンクする

作成したボタンをダブルクリックします。
ボタンのVBAソースコードを書き入れる場所(シートモジュール)にボタンが押された時に実行される中身が空っぽのプログラムが自動で書き込まれます。

図28 シートモジュール


ボタンが押された時に実行される中身が空っぽのプログラムで、上のVBAソースコードを呼び出す命令を書き入れます。

そして、上書き保存して、Visual Basic Editor を閉じます。

図29 シートモジュール


ボタンの作り込み

作成したボタンの上で右クリックする。
右クリックメニューの『プロパティ』をクリックします。

図30 ボタンの設定


プロパティウィンドウの『Accelerator』と『Caption』を変更する。

図31 プロパティウィンドウ


『Accelerator』はアルファベットを1文字入力します。
仮にアルファベットの『 A 』を入力したとすると、『 Alt + A 』でボタンが押せる様になります。

『Caption』はボタンに表示される文字列を入力します。
『Accelerator』に入力したアルファベットが入力されると自動で下線が着きます。

図32 プロパティウィンドウ


ボタンが完成しました。
あとはデザインモードボタンを押して、デザインモードを解除します。

図33 ボタン完成



結果

インストーラ.xlsm を起動して、インストールボタンを押すと、デスクトップ画面にアイコンが出来ました。


図34 作成されたアプリケーション



コメント

Cドライブに『自作アプリ』などのフォルダを作成しておいて、作成したアプリケーションを『自作アプリ』フォルダに入れて、インストールしましょう。

自作アプリは『自作アプリ』フォルダの中に集約され、VBScript で作成したプログラムは簡単にドラッグ&ドロップ機能を組み込めるので、わずらわしい操作を排除できます。

また、アイコンもアプリケーション毎に付けられるので、デスクトップ画面でもなんのアプリがどこにあるのかが分かりやすくなります。

今回作成した印刷アプリでは無くて Excel 操作の必要なアプリケーションだとしても、VBScript から Excel VBA を呼び出す事も出来ます。もちろん他の exe ファイルなんかも VBScript から呼び出せます。
VBScript から呼び出さなくてもショートカットさえ作れるならプログラムを作る言語は何でも良いです。

社内配布などした時にもわりと受け入れられやすそうなアプリケーションになったのでは無いでしょうか。



以上