EXCEL VBA エクセルシートに押印処理を行う・ダブルクリックで押印（判子・電子印鑑・スタンプ）（テクニック）
EXCEL VBA エクセルシートに押印処理を行う・ダブルクリックで押印（判子・電子印鑑・スタンプ）（テクニック）
EXCEL VBA ダブルクリックをしてワークシートに個人印を押印します。（イベントプロシージャ：WorkSheet Before DoubleClick) （シート単位）
下記のサンプルプログラムは、ワークシートに個人印を押印するサンプルプログラムです。今回のサンプルプログラムは、ワークシート（Sheet１）に対してイベントプロシージャを利用して押印するサンプルプログラムです。
なお、押印は、マウスポインターで指定したセル位置に印影が表示されます。
【イベントプロシージャ】
※今回のプログラムは、イベントプロシージャを利用して、ワークシート（Sheet1）にダブルクリックして押印するプログラムが実行されるように、設定します。
①Sheet1をクリックする。（このシートに設定）
②WorkSheetを設定します。
③Before Doubleを設定します。（マウスでダブルクリックで実行）
④下記のプログラム（コード）は、Sheet１（Sheet１）に記述します。
【プログラムの流れ】
① ワークシート（Sheet1）で押印したい位置でダブルクリックします。
② 押印するかのメッセージボックスが表示されます。
③ メッセージに対して「はい」・・押印します。「いいえ」・・何もしない
※押印は、何度も押印する事が出来ます。
【プログラム実行条件】
担当者印データをデスクトップに保存します。
※デスクトップへのパスは、環境により異なるので、自身のPC環境に合わせて担当者のパス位置を設定してください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
' ' Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim SetCells As Range Dim Rc As Integer Set SetCells = ActiveCell Rc = MsgBox("押印しますか？", vbYesNo + vbQuestion, "確認") '押印するか確認 If Rc = vbYes Then With Pictures.Insert("C:\Users\akira\OneDrive\デスクトップ\suzuki.png") '担当印を設定 （デスクトップの位置は環境により異なります。） .Top = SetCells.Top .Left = SetCells.Left .Width = SetCells.Width End With End If Set SetCells = Nothing End Sub ' |
（画面クリックして拡大）
EXCEL VBA ダブルクリックをしてワークシート毎に別の角印を押印します。（イベントプロシージャ：WorkBook Sheet Before DoubleClick) （ブック単位）
なお、押印は、マウスポインターで指定したセル位置に印影が表示されます。
※今回のプログラムは、イベントプロシージャを利用して、ワークシート（請求書・領収書）毎にダブルクリックしておのおのの角印が押印されます。
・ワークシート「請求書」⇒ 請求印
・ワークシート「領収書」⇒ 領収印
| 請求印 | 領収印 |
|---|---|
 |  |
【イベントプロシージャ】
※今回のプログラムは、イベントプロシージャを利用して、ワークシート（Sheet1：請求書）と（Sheet２：領収書）にダブルクリックする事で、指定した押印をするプログラムが実行されるように、設定します。
①ThisWorkbookをクリックする。（このBook（ブック）に設定）
②Workbookを設定します。
③Sheet Before Doubleを設定します。（マウスでダブルクリックで実行）
④下記のプログラム（コード）は、ThisWorkbookに記述します。※WorkBookに記述する事で、WorkBook（全てのWorkSheet）に対してダブルクリックで実行されます。
【プログラムの流れ】
① 押印するワークシートを選択します。
② 押印したい位置でダブルクリックします。
③ 押印するかのメッセージボックスが表示されます。
④ メッセージに対して「はい」・・押印します。「いいえ」・・何もしない
※押印は、何度も押印する事が出来ます。
【プログラム実行条件】
①請求印データを [ C:\DATA\請求印.png ] に保存する。
②領収印データを [ C:\DATA\領収印.png ] に保存する。
|
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 |
' ' Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Dim StampPass As String Dim SetCells As Range Dim Rc As Integer Set SetCells = ActiveCell Rc = MsgBox("押印しますか？", vbYesNo + vbQuestion, "確認") '押印するか確認 If Rc = vbYes Then If ActiveSheet.Name = "請求書" Then StampPass = "C:\DATA\請求印.png" ElseIf ActiveSheet.Name = "領収書" Then StampPass = "C:\DATA\領収印.png" Else MsgBox "該当するシートが選択されていません。" Exit Sub End If With ActiveSheet.Pictures.Insert(StampPass) '角印を設定 .Top = SetCells.Top .Left = SetCells.Left .Width = SetCells.Width End With End If Set SetCells = Nothing End Sub ' |
（画面クリックして拡大）
EXCEL VBA ダブルクリックをして登録されている氏名に応じて自動的に個人印を押印します。（イベントプロシージャ：WorkBook Sheet Before DoubleClick) （複数印鑑）
なお、押印は、マウスポインターで指定したセル位置に印影が表示されますので、同じ列ならどの位置でも可能です。
※今回のプログラムは、イベントプロシージャを利用して、F列に登録されている氏名に応じてダブルクリックで個人印が押印されます。
| 氏名 | 個人印の印影 |
|---|---|
| 竈門炭治郎 |  |
| 嘴平伊之助 |  |
| 煉獄杏寿郎 |  |
| 甘露寺蜜璃 |  |
| 胡蝶しのぶ |  |
【イベントプロシージャ】
※今回のプログラムは、イベントプロシージャを利用して、アクティブワークシートにダブルクリックする事で、指定列に該当する押印するプログラムが実行されるように、設定します。
①ThisWorkbookをクリックする。（このBook（ブック）に設定）
②Workbookを設定します。
③Sheet Before Doubleを設定します。（マウスでダブルクリックで実行）
④下記のプログラム（コード）は、ThisWorkbookに記述します。※WorkBookに記述する事で、WorkBook（全てのWorkSheet）に対してダブルクリックで実行されます。
【プログラムの流れ】
① 押印する氏名横（F列）の確認印（G列）の位置でダブルクリックします。
② 押印するかの氏名＋メッセージボックスが表示されます。
③ メッセージに対して「はい」・・押印します。「いいえ」・・何もしない
※押印は、何度も押印する事が出来ます。
※押印範囲は、行ごとに押す事ができるので、確認印（G列）以外でも同じ行でしたら、同じ印影が押印されます。
【プログラム実行条件】
①竈門印データを [ C:\DATA\竈門.png ] に保存する。
②嘴平印データを [ C:\DATA\嘴平.png ] に保存する。
③煉獄印データを [ C:\DATA\煉獄.png ] に保存する。
④甘露寺印データを [ C:\DATA\甘露寺.png ] に保存する。
⑤胡蝶印データを [ C:\DATA\胡蝶.png ] に保存する。
|
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 39 40 41 42 43 44 45 46 47 48 49 |
' ' Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) Dim StampPass As String Dim SetCells As Range Dim Rc, L As Integer Set SetCells = ActiveCell 'アクティブセルをセットします。 L = SetCells.Row 'アクティブセルの行番号取得 Rc = MsgBox(ActiveSheet.Cells(L, "F") & "の押印しますか？", vbYesNo + vbQuestion, "確認") '押印するか確認 If Rc = vbYes Then Select Case ActiveSheet.Cells(L, "F") 'F列の登録されている氏名から印影パスを取得します。 Case "竈門炭治郎" StampPass = "C:\DATA\竈門.png" Case "嘴平伊之助" StampPass = "C:\DATA\嘴平.png" Case "煉獄杏寿郎" StampPass = "C:\DATA\煉獄.png" Case "甘露寺蜜璃" StampPass = "C:\DATA\甘露寺.png" Case "胡蝶しのぶ" StampPass = "C:\DATA\胡蝶.png" Case Else MsgBox "登録されていない氏名が入力されています。" Exit Sub End Select With ActiveSheet.Pictures.Insert(StampPass) '該当する個人印を押印 .Top = SetCells.Top .Left = SetCells.Left .Width = SetCells.Width End With End If Set SetCells = Nothing End Sub ' |
（画面クリックして拡大）
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。