EXCEL VBA 請求書・領収書の作成・自動判定・自動押印（電子印鑑）丸印・角印（テクニック）

●はじめに

今回説明するサンプルプログラムは、以前紹介した「EXCEL　VBA　請求書の作成・一覧表からの請求書発行・・・」の機能追加したサンプルプログラムです。機能を追加した部分は、【請求一覧】のデータから自動判定して、請求印と領収印及び担当者の印影を挿入してPDFやプリンターへ出力する機能です。データの登録条件により、自動的に押印処理が出来るので、大量に発行する際には、押印処理が省けるのでその分、業務の効率化が図られます。それでは、順番に説明いたします。

●【今回のプログラムは、【請求書の作成・一覧表からの請求書発行】の内容を引用して作成していますので、請求書作成の全体部分については、、下記を参照して下さい】

EXCEL　VBA　請求書・領収書の角印（電子印鑑）を自動判定にて自動押印しPDF出力します。

●プログラム説明　(サンプル①)

下記のサンプルプログラムは、請求書や領収書で使用する角印を出力するデータに応じて、自動判定して角印を自動押印（挿入）するサンプルプログラムです。２パターンのプログラムを作成しており、一つ目は請求書・領収書をPDF化するバージョンともう一つは、プリンター等へ紙に出力する２パターンを作成しています。また、担当者の個別の丸印にも対応しているので、担当者が押印せずに、請求書・領収書を発行する事が出来ます。

【プログラム説明】

・ワークシート名「請求一覧」に登録されているデータ、D列に「担当者」・P列に「区分」が登録されています。このD列とP列のデータを元に電子印を自動押印します。
・ワークシート名「請求一覧」・・・下表の一覧表（請求書・領収書発行に必要なデータが登録されています）
・ワークシート名「請求書・領収書」・・・請求書・領収書の雛形として利用します。（請求書・領収書を発行する時にデータを転記します。）
・

【電子印種類】

電子印種類	印影
請求印
領収印
鈴木
佐藤
高橋
伊藤
田中

・区分【P列】には、請求書・領収書が登録されています【請求書】は、・・・請求印　：　【領収書】は、・・・領収印
・担当者【D列】は、各担当者の氏名が登録されていますので、該当する氏名の丸印を請求書・領収書に反映します。

【請求書・領収書】印影場所の事前設定

【プログラム実行条件】

・ワークシート名「請求一覧」・・・請求書・領収書を発行する元となる情報が登録します。「A列からP列まで」
・ワークシート名「請求書・領収書」・・・請求書・領収書の雛形を作成します。
・角印「請求印・領収印」及び丸印「個人印」は、C:\印鑑ファイル　⇒　フォルダーに保存する。

'
'''******** AKIRA55.COM ******* https://akira55.com/electronic_stamp/
'
Sub 請求書_領収書発行_PDFファイル出力()   '自動判定にて電子印鑑を押印・PDFファイルに出力

    Dim ws01, ws02 As Worksheet
    Dim L, I, Con, lRow, mRow As Long
    Dim RC As Integer
    Dim myFile, HankoFile As String
    Dim Image_del As Picture
    
    
    Set ws01 = Worksheets("請求一覧")
    Set ws02 = Worksheets("請求書・領収書")
    
    lRow = ws01.Cells(Rows.Count, "B").End(xlUp).Row '社員コードの最終行を取得
    
    HankoFile = "C:\印鑑ファイル"  '印鑑ファイルの保存先
    
    
    For I = 2 To lRow  '請求書・領収書を印刷する枚数をカウントします。
    
        If ws01.Cells(I, "O") <> "済" Then
            Con = Con + 1    '発行「済み」以外をカウントします。

        End If
    
    Next I
    
    RC = MsgBox("請求書・領収書を発行します。　" & Con & "枚分印刷しますか？", vbYesNo + vbQuestion, "確認")
    
    If RC = vbNo Then
                MsgBox "処理を中断します"
                Exit Sub  'プログラムを終了します。
    End If
    
    myFile = ThisWorkbook.Path & "\" 'ブックと同じ場所をPDFの保存先に指定します。
    
    For I = 2 To lRow 'シート「請求一覧」の最終行まで印刷を行います。
        
        If ws01.Cells(I, "O") <> "済" Then  '印刷済み以外の請求書を印刷します。
        
            
                '------------------------------------------------------
                'ワークシート（請求一覧）⇒　ワークシート（請求書・領収書）へデータ転記する。
                
                If ws01.Cells(I, "P") = "請求書" Then
                        ws02.Range("区分") = "請求書"   '表題に請求書を指定
                                Else
                        ws02.Range("区分") = "領収書 "  '表題に領収書を指定
                End If
                
                
                ws02.Range("請求NO") = ws01.Cells(I, "A")
                ws02.Range("請求先") = ws01.Cells(I, "B")
                ws02.Range("件名") = ws01.Cells(I, "C")
                
                ws02.Range("項目①") = ws01.Cells(I, "E")
                ws02.Range("数量①") = ws01.Cells(I, "F")
                ws02.Range("単価①") = ws01.Cells(I, "G")
                
                ws02.Range("項目②") = ws01.Cells(I, "H")
                ws02.Range("数量②") = ws01.Cells(I, "I")
                ws02.Range("単価②") = ws01.Cells(I, "J")
                
                ws02.Range("項目③") = ws01.Cells(I, "K")
                ws02.Range("数量③") = ws01.Cells(I, "L")
                ws02.Range("単価③") = ws01.Cells(I, "M")
                
                ws02.Range("備考") = ws01.Cells(I, "N")
                
                For Each Image_del In ws02.Pictures  '印鑑削除
                        Image_del.Delete
                Next Image_del
        
                With ws02.Pictures.Insert(HankoFile & "\" & ws01.Cells(I, "P") & ".png")  '角印挿入
                    .Top = ws02.Range("角印").Top
                    .Left = ws02.Range("角印").Left
                    .Width = ws02.Range("H20:I24").Width
    
                End With
                
                With ws02.Pictures.Insert(HankoFile & "\" & ws01.Cells(I, "D") & ".png")  '担当印挿入
                    .Top = ws02.Range("担当者").Top
                    .Left = ws02.Range("担当者").Left
                    .Width = ws02.Range("I17:I18").Width
    
                End With
                
                
                
                '- ws02.PrintOut From:=1, To:=1  '請求書を印刷（１ページ）-----------------------------------------------------

                ws02.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile & ws02.Range("請求先") & "-" & ws02.Range("区分") & ".pdf" '請求書をPDFへ出力
                
                ws01.Cells(I, "O") = "済"  '印刷後、「印刷済み」＝「済」にする
        End If
    Next I
    
End Sub
'

●実行前～実行後　※プログラム実行後、ワークシート「請求一覧」O列「発行」が空白データに対して、請求書・領収書の発行し自動に角印・丸印が挿入されPDFファイルとして発行されました。
（画面クリックして拡大）

EXCEL　VBA　請求書・領収書の角印（電子印鑑）を自動判定にて自動押印しプリンターへ出力します。

●プログラム説明　(サンプル②)

下記のサンプルプログラムは、上記のサンプルプログラムと同じ条件で請求書・領収書の角印・丸印を自動判定して、印影を挿入しプリンターへ出力するサンプルプログラムです。

全体的には、【プログラム説明（サンプル①）】と同じプログラムなので、サンプル①を参照して下さい。

'
'******** AKIRA55.COM ******* https://akira55.com/electronic_stamp/
'
Sub 請求書_領収書発行_紙に出力()   'プリンターに出力（紙）


    Dim ws01, ws02 As Worksheet
    Dim L, I, Con, lRow, mRow As Long
    Dim RC As Integer
    Dim myFile, HankoFile As String
    Dim Image_del As Picture
    
    
    Set ws01 = Worksheets("請求一覧")
    Set ws02 = Worksheets("請求書・領収書")
    
    lRow = ws01.Cells(Rows.Count, "B").End(xlUp).Row '社員コードの最終行を取得
    
    HankoFile = "C:\印鑑ファイル"  '印鑑ファイルの保存先
    
    
    For I = 2 To lRow  '請求書・領収書を印刷する枚数をカウントします。
    
        If ws01.Cells(I, "O") <> "済" Then
            Con = Con + 1    '発行「済み」以外をカウントします。

        End If
    
    Next I
    
    RC = MsgBox("請求書・領収書を発行します。　" & Con & "枚分印刷しますか？", vbYesNo + vbQuestion, "確認")
    
    If RC = vbNo Then
                MsgBox "処理を中断します"
                Exit Sub  'プログラムを終了します。
    End If
    
    myFile = ThisWorkbook.Path & "\" 'ブックと同じ場所をPDFの保存先に指定します。
    
    For I = 2 To lRow 'シート「請求一覧」の最終行まで印刷を行います。
        
        If ws01.Cells(I, "O") <> "済" Then  '印刷済み以外の請求書を印刷します。
        
            
                '------------------------------------------------------
                'ワークシート（請求一覧）⇒　ワークシート（請求書・領収書）へデータ転記する。
                
                If ws01.Cells(I, "P") = "請求書" Then
                        ws02.Range("区分") = "請求書"   '表題に請求書を指定
                                Else
                        ws02.Range("区分") = "領収書 "  '表題に領収書を指定
                End If
                
                
                ws02.Range("請求NO") = ws01.Cells(I, "A")
                ws02.Range("請求先") = ws01.Cells(I, "B")
                ws02.Range("件名") = ws01.Cells(I, "C")
                
                ws02.Range("項目①") = ws01.Cells(I, "E")
                ws02.Range("数量①") = ws01.Cells(I, "F")
                ws02.Range("単価①") = ws01.Cells(I, "G")
                
                ws02.Range("項目②") = ws01.Cells(I, "H")
                ws02.Range("数量②") = ws01.Cells(I, "I")
                ws02.Range("単価②") = ws01.Cells(I, "J")
                
                ws02.Range("項目③") = ws01.Cells(I, "K")
                ws02.Range("数量③") = ws01.Cells(I, "L")
                ws02.Range("単価③") = ws01.Cells(I, "M")
                
                ws02.Range("備考") = ws01.Cells(I, "N")
                
                For Each Image_del In ws02.Pictures  '印鑑削除
                        Image_del.Delete
                Next Image_del
        
                With ws02.Pictures.Insert(HankoFile & "\" & ws01.Cells(I, "P") & ".png")  '角印挿入
                    .Top = ws02.Range("角印").Top
                    .Left = ws02.Range("角印").Left
                    .Width = ws02.Range("H20:I24").Width
    
                End With
                
                With ws02.Pictures.Insert(HankoFile & "\" & ws01.Cells(I, "D") & ".png")  '担当印挿入
                    .Top = ws02.Range("担当者").Top
                    .Left = ws02.Range("担当者").Left
                    .Width = ws02.Range("I17:I18").Width
    
                End With
 
                ws02.PrintOut From:=1, To:=1  '請求書又は、領収書を印刷（１ページ）----------

                ws01.Cells(I, "O") = "済"  '印刷後、「印刷済み」＝「済」にする

        End If

    Next I
End Sub
'

最後まで、ご覧いただきまして誠に有難うございました。
また、VBAに関するテクニックや便利な手法などをこのサイトに掲載していきますので、定期的に参照していただけると幸いです。

AKIRA