ダウンロード
概要
Excelで電子印をダブルクリックでポンポン押すことができるマクロを作りました。
社内で使用する申請書や、FAX送信時など画像の挿入を行う手間を省けます。
私は、デイケアに勤めていた際にモニタリング用紙を居宅へFAX送信する際や、費用清算書に捺印する代わりに使用していました。
※公的文書にはご使用いただけません
使い方
フォルダをコピーまたは、切り取って任意の場所へ移動させて下さい。
zipファイルのままでは正しく作動しない恐れがあります。
押印フォルダの中身は上図のようになっています。
印影フォルダの中に必要な印影の画像ファイルを入れてください。
デフォルトでは上図の4つの印影が入っています。
押印ボタンを押すとフォームが出現します。
※動作を分かりやすくするため、セルD4を大きくし罫線を入れています。
オプションボタンにチェックを入れ、セルをダブルクリックすることで押印できます。
印はセルの左上に合わせて、セルの大きさに対応して挿入されます。
セルを正方形にすることで、サイズをぴったりにできます。
あとは、シートをお好きなテンプレートに編集してお使い頂けます。
デフォルトでは、印を8つまで登録することが出来ますが、登録できる印の数を変更する方法も後述しています。
VBAコード
コードをみていきましょう
ボタン処理
|
1 2 3 |
Sub 押印システム() UserForm1.Show vbModeless End Sub |
ユーザーフォームをモードレスで表示させています。
ユーザーフォームInitialize
ユーザーフォームを表示させた際に印影フォルダを参照して
印影のファイル名をテキストボックスに表示させるコードです。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 |
Private Sub UserForm_Initialize() Dim i As Long Dim FilePath As String Dim FSO As Object Dim FolderItem As Files Dim Inei As Object Dim TB As Object FilePath = ThisWorkbook.Path & "\印影" Set FSO = New FileSystemObject Set FolderItem = FSO.GetFolder(FilePath).Files For Each TB In UserForm1.Controls 'テキストボックスの数をカウント If TB.Name Like "*TextBox*" Then a = a + 1 'aがテキストボックスの数 End If Next TB i = 1 For Each Inei In FolderItem Controls("TextBox" & i).Value = Inei.Name i = i + 1 If i > a Then 'Textbox(i)がテキストボックスの数(a)を超えたら終了 Exit For End If Next End Sub |
ユーザーフォームのコードは、ユーザーフォームを選択した状態で、左赤〇の「コードを表示」
または、ユーザーフォームをダブルクリックすることで表示できます。
このコードにはFileSystemObjectを使用しており、準備としてライブラリファイル”Microsoft Scripting Runtime”を参照しています。
ダウンロードして頂いたExcelファイルを使用して頂ける場合はデフォルトで参照設定をしていますので、以下は読み飛ばしていただいて大丈夫です。
当記事を参考に一からVBAを記述されている場合は以下を参考にしてください。
ライブラリファイル”Microsoft Scripting Runtime”を参照
ツールの参照設定をクリック
Microsoft Scripting Runtimeにチェックを入れてOK
VBA コードの内容
|
1 |
FilePath = ThisWorkbook.Path & "\印影" |
印影フォルダのパス
Excelファイルを置いている階層の印影フォルダを参照するように設定しています。
なので、押印フォルダの位置関係を変更しないようにしてください。
もし、独自の印影フォルダがある場合は、パスを指定して頂いて構いません。
|
1 2 |
Set FSO = New FileSystemObject Set FolderItem = FSO.GetFolder(FilePath).Files |
FileSystemObjectを用いて、印影フォルダの中にあるファイルを全て参照します。
参照したファイルはFolderItemに格納しています。
|
1 2 3 4 5 |
For Each TB In UserForm1.Controls 'テキストボックスの数をカウント If TB.Name Like "*TextBox*" Then a = a + 1 'aがテキストボックスの数 End If Next TB |
後に登録できる印影の数を変更できるように、テキストボックスの個数（登録できるようにしたい数）をカウントし”a”に格納します。
|
1 2 3 4 5 6 7 8 |
i = 1 For Each Inei In FolderItem Controls("TextBox" & i).Value = Inei.Name i = i + 1 If i > a Then 'Textbox(i)がテキストボックスの数(a)を超えたら終了 Exit For End If Next |
繰り返し処理を用いて、印影フォルダの中にある印影画像ファイル（のパス）を順にテキストボックスへ入力しています。
入力するテキストボックスが無ければエラーを呈すため、If文・Exit for お用いて繰り返し処理から脱却するようにしています。
ユーザーフォーム編集（登録できる印影の増量）
オプションボタンとテキストボックスをコピーするだけでOKです。
念の為オプションボタンとテキストボックスのオブジェクト名の数字が対応していることを確認してください。
※オブジェクトのコピーは選択してCtrlキー＋ドラッグで出来ます。
WorkSheets イベントプロシージャ
ダブルクリックで押印を行うコードです
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 |
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim FilePath As String Dim SetCell As Range Dim OP As Object Dim i As Long, a As Long FilePath = ThisWorkbook.Path & "\印影" Set SetCell = ActiveCell For Each OP In UserForm1.Controls 'オプションボタンの数をカウント If OP.Name Like "*OptionButton*" Then a = a + 1 'aがオプションボタン数 End If Next OP 'オプションボタンとテキストボックスの数字は対応しています '例）optionbutton1 → textbox1 For i = 1 To a If UserForm1.Controls("OptionButton" & i).Value = True Then If UserForm1.Controls("TextBox" & i).Value = "" Then MsgBox "印影が登録されていません" Else With Pictures.Insert(FilePath & "\" & UserForm1.Controls("TextBox" & i).Value) '印のアドレスを取得し押印 .Top = SetCell.Top '上端の位置 .Left = SetCell.Left '左端の位置 .Width = SetCell.Width '幅 .Height = SetCell.Height '高さ End With SetCell.Offset(1, 0).Select End If End If Next i End Sub |
イベントプロシージャの場所
イベントプロシージャは赤〇の位置にあります。
シート名が表示されます。
ThisWorkbookはワークブックのイベントプロシージャです。
VBA コードの内容
|
1 2 |
FilePath = ThisWorkbook.Path & "\印影" Set SetCell = ActiveCell |
FilePath：印影フォルダのパスを指定
SetCell：ダブルクリックしたセルを指定
|
1 2 3 4 5 |
For Each OP In UserForm1.Controls 'オプションボタンの数をカウント If OP.Name Like "*OptionButton*" Then a = a + 1 'aがオプションボタン数 End If Next OP |
繰り返し処理を用いて、ユーザーフォームのオプションボタンの数をカウントして”a”へ格納
<全文>
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
For i = 1 To a If UserForm1.Controls("OptionButton" & i).Value = True Then If UserForm1.Controls("TextBox" & i).Value = "" Then MsgBox "印影が登録されていません" Else With Pictures.Insert(FilePath & "\" & UserForm1.Controls("TextBox" & i).Value) '印のアドレスを取得し押印 .Top = SetCell.Top '上端の位置 .Left = SetCell.Left '左端の位置 .Width = SetCell.Width '幅 .Height = SetCell.Height '高さ End With SetCell.Offset(1, 0).Select End If End If Next i |
For～Next文で1からa（オプションボタンの個数）まで繰り返し処理を行います
<各文>
|
1 |
If UserForm1.Controls("OptionButton" & i).Value = True Then |
もしいずれかのオプションボタンがTRUEなら処理開始
|
1 2 |
If UserForm1.Controls("TextBox" & i).Value = "" Then MsgBox "印影が登録されていません" |
もしオプションボタンに対応したテキストボックスが空白なら
（印影が無いので）
メッセージボックスを表示「印影が登録されていません」
|
1 2 3 4 5 6 |
With Pictures.Insert(FilePath & "\" & UserForm1.Controls("TextBox" & i).Value) '印のアドレスを取得し押印 .Top = SetCell.Top '上端の位置 .Left = SetCell.Left '左端の位置 .Width = SetCell.Width '幅 .Height = SetCell.Height '高さ End With |
Pictures.Insertメソッドで画像を挿入します（画像ファイルのパスを指定）
Top:上端の位置
Left:左端の位置
Width:画像の幅
Height:画像の高さ
VBAは上から順に命令が遂行されますので
❶上端を合わせて
❷左端を合わせて
❸幅を合わせてから
❹高さを合わせます
つまり、幅より高さを優先されます。
↑高さ（行）より幅（列）が大きい時
↑高さ（行）が幅（列）より大きい時
先述のように、印影の多くは正方形なので、セルを正方形にしておけば、サイズぴったりです。
イベントプロシージャのコピー
Worksheetsのイベントプロシージャはシートをコピーすることで自動的に反映されます。
マクロボタンも一緒にコピーされます。
まとめ
押印する箇所が多い時
ダブルクリックで押印できるとストレスフリーです。
お好きなテンプレートをシートに張り付けて
ぜひ活用してみてください。
最後にダウンロードリンクを再度提示しておきます。
コメント