複製したテンプレートにデータを入力。FAX注文書の完成

エクセルVBAで作るFAX注文書の最終作成作業です。
第3回目作成のテンプレートに「書籍データ」「店番線」「送信先FAXNo」のデータを入力します。

こんにちは、じゅんぱ店長（@junpa33）です。

テンプレートを複製して出版社別の注文書シートを完成させます。

「FAX注文書テンプレート.xlsm」での作業を中心に行います。

テンプレートを出版社別に複製して、「書籍データ」「店番線」「送信先FAXNo」を各シートに挿入します。

「書籍データ」は発注資料表より、「店番線」は設定とスタートより、「送信先FAXNo」は別ブックのFAX電話帳からのデータ入手を行います。

ＦＡＸ注文書作成の記事編成

FAX注文書作成ツールの使い方とダウンロード
- FAX注文書作成ソフトの無料ダウンロードと使い方

FAX注文書作成の作成手順

コンテンツ

FAX注文書を完成させるVBA全コード

ここで菅亞聖させるVBAコードは4つのブロック（プロシージャー）で構成しています。

モジュールの先頭部分

ブックとシートオブジェクトを頻繁に指定していきますので、略語の様な使い方で、変数に代入しておきます。

VBA

Option Explicit

Function wbT() As Workbook
    Set wbT = Workbooks("FAX注文書テンプレート.xlsm")
End Function

Function wsSST() As Worksheet
Set wsSST = Worksheets("設定とスタート")
End Function

Function wsTMP() As Worksheet
Set wsTMP = Worksheets("テンプレート")
End Function

Function wsHSD() As Worksheet
Set wsHSD = Worksheets("発注資料表")
End Function

VBAコード本体部

FAX注文書を作成するための中心となるVBAコードです。

VBA

Sub メインデータ転記()
    Dim BNa, BNb As Integer
    Dim Nrow, S, t, tt As Long
    Dim FAX As Boolean
    Dim e, ee, x As Long
    Dim Sn As String
    Dim PR As Long
    Dim SUV, SOV, TYV, SJV, ISV, TDV As String
    Dim BV, SAV, HOV, SIV, HAV, KYV As Variant
    Dim DR, tela, telb As Variant
    Dim SUVa As String
'番線印のチェックボックスを調べる
        If wsSST.CheckBoxes(1).Value = xlOn Then
            BNa = 1
        End If
        If wsSST.CheckBoxes(2).Value = xlOn Then
            BNb = 1
        End If
        If BNa = 1 And BNb = 1 Then BNa = 0
'発注資料表のN列の「〇」の最終行を調べる
        wbT.Activate
        With wsHSD
            .Select
            Nrow = .Cells(Rows.Count, 13).End(xlUp).Row
            e = Nrow Mod 9
            ee = Nrow \ 9
        End With
        
            If ee = 0 Then
                If e < 3 Then
                    MsgBox "作成するＦＡＸ注文書はありません。", vbOKOnly _
                            + vbExclamation, "FAX注文書テンプレート"
                    wsSST.Select
                    Exit Sub
                Else
                    x = 1
                End If
            Else
                x = ee + 1
            End If
'テンプレートを複製する
        With wsTMP
            For S = x To 1 Step -1
                Sn = "Ｐ" & S
                .Select
                .Copy after:=wsTMP
                ActiveSheet.Name = Sn
            Next S
        End With
'FAX電話帳の存在を調べる
        FAX = True
        If Dir(wbT.Path & "\FAX電話帳.xlsx") = "" Then
            MsgBox "「FAX電話帳.xlsx」はありませんので、" & vbCrLf & _
            "電話番号検索は行ないません。", vbInformation, _
            "FAX注文書テンプレート"
            FAX = False
        End If
'テンプレートに発注書籍データを転記する
        For S = x To 1 Step -1
            Sn = "Ｐ" & S
            For t = 1 To 5
                wbT.Activate
                
                With wsHSD
                    .Select
                    On Error Resume Next
                    PR = WorksheetFunction.Match(Sn, .Columns("A"), 0) + 1
                    If PR = 0 Then
                        MsgBox "FAX発注書の作成でエラーが発生しました。" _
                        & vbCrLf & "発注書作成を再度行なってください。", _
                        vbExclamation, "FAX注文書テンプレート"
                        Exit Sub
                    End If
                    On Error GoTo 0
            '分類名
                    BV = .Range("A" & PR + t)
            '出版社名
                    SUV = .Range("B" & PR + t)
            '書名
                    SOV = .Range("C" & PR + t)
            '著者名
                    TYV = .Range("D" & PR + t)
            '冊数
                    SAV = .Range("E" & PR + t)
            '本体価格
                    HOV = .Range("F" & PR + t)
            'シリーズ名
                    SIV = .Range("G" & PR + t)
            '版数
                    HAV = .Range("H" & PR + t)
            '送品条件
                    SJV = .Range("I" & PR + t)
            'ＩＳＢＮ
                    ISV = .Range("J" & PR + t)
            '客注名
                    KYV = .Range("K" & PR + t)
                    If SOV = "" Then
                        TDV = ""
                        Else
            '発注日
                        TDV = Date
                    End If
                End With
                
                With Worksheets(Sn)
                    .Select
                    tt = (t - 1) * 4
                    Cells(3, 22 - tt) = SAV
                    Cells(4, 21 - tt) = "ＩＳＢＮ " & ISV
                    Cells(5, 21 - tt) = SJV
                    Cells(7, 24 - tt) = SUV
                    Cells(7, 22 - tt) = SIV & vbCrLf & SOV
                    Cells(9, 24 - tt) = TYV
                    Cells(10, 22 - tt) = HAV & "版"
                    Cells(11, 22 - tt) = HOV
                    Cells(12, 22 - tt) = TDV
                    Cells(13, 22 - tt) = KYV
                    Cells(15, 21 - tt) = BV
                End With
                
                If SUV <> "" Then
                    Worksheets(Sn).Range("AD2") = SUV & "　　様"
                    SUVa = Trim(SUV)
'FAX電話帳が有る場合に番号を検索する
                    If FAX = True Then
                        Workbooks.Open Filename:=wbT.Path & "\FAX電話帳.xlsx"
                        Worksheets("電話番号").Select
                        On Error Resume Next
                        DR = WorksheetFunction.Match(SUVa, _
                                    Worksheets("電話番号").Columns("A"), 0)
                        On Error GoTo 0
                        If DR <> 0 Then
                            tela = Range("B" & DR)
                            telb = Range("C" & DR)
                            wbT.Activate
                            Worksheets(Sn).Select
                            Range("B12") = "FAX　" & tela
                            Range("A12") = "TEL　" & telb
                        End If
                    End If
                End If
'番線印を押す
                    wbT.Activate
                    Worksheets(Sn).Select
                    
                    If Val(BNa) = 1 Then
                        If SAV > 0 Then
                            wsSST.Range("H13").Copy _
                            Worksheets(Sn).Range(Cells(2, 21 - tt), _
                                                        Cells(2, 24 - tt))
                        End If
                    ElseIf BNb = 1 Then
                        If Val(SAV) > 0 Then
                            wsSST.Range("I13").Copy _
                            Worksheets(Sn).Range(Cells(2, 21 - tt), _
                                                        Cells(2, 24 - tt))
                        Else
                        End If
                    End If
            Next t
            DR = 0
        
        Next S
        If FAX = True Then
            Workbooks("FAX電話帳.xlsx").Close False
        End If
End Sub

FAX発信元情報入力

注文元（自店）の情報を転記します。

VBA

Sub 発信元セット()
    Dim HJa, HJb, HJc, HJd, HJe As Variant
        With wsSST
            .Select
            HJa = .Range("I3")
            HJb = .Range("I4")
            HJc = .Range("I5")
            HJd = .Range("I6")
            HJe = .Range("I7")
        End With
        With wsTMP
            .Select
            .Range("AD10") = HJa
            .Range("AC10") = HJb
            .Range("AB10") = HJc
            .Range("AA10") = HJd
            .Range("Z10") = HJe
        End With
End Sub

利用済データ、FAX注文書のクリアと削除

次回利用のため、使用済データをクリア・削除します。

VBA

Sub オールクリアー()
    Dim Nrow, e, ee, x, S As Long
    Dim Sn As String
'発注資料表からシートの展開状況を判断する
        wsHSD.Select
        Nrow = Cells(Rows.Count, 13).End(xlUp).Row
        e = Nrow Mod 9
        ee = Nrow \ 9
        If ee = 0 Then
            If e < 3 Then
              wsSST.Select
              Range("A1").Select
              Exit Sub
            Else
               x = 1
            End If
        Else
            x = ee + 1
        End If
'追加したテンプレートシートを削除する
        Application.DisplayAlerts = False
        If Worksheets.Count > 3 Then
            For S = 1 To x
                    Sn = "Ｐ" & S
                    Worksheets(Sn).Delete
            Next S
            Application.DisplayAlerts = True
        End If
'発注資料表をクリアする
        With wsHSD.Cells
            .Clear
            .UseStandardHeight = True
            .UseStandardWidth = True
        End With
        Application.DisplayAlerts = True
        wsSST.Activate
        Range("A1").Select
End Sub

目次へ戻る

記述コードの解説

順番にコードの説明を行っていきます。

モジュールの先頭部分

モジュール記述の最初に、

Functionプロシージャーでブックとシートのオブジェクトを変数に代入するコードを作成しておきます。

これにより以降は、変数でオブジェクトを表すことが出来ます。

ここでの参考記事

Functionプロシージャーとユーザー定義関数

書籍データ入力に関わるコード

発注資料表のページ数分のテンプレート複製

「テンプレート」シートの注文書テンプレートは ” 原紙 ” となります。

適宜、コピーをして使用します。コピーの枚数は、「発注資料表」に表示されているページ数分となります。

コピーしたテンプレートのシート名を「P1～」と名付けます。

MEMO

「Add」メソッドは名前の通りシートを追加します。この場合はSheet4，Sheet5と増えていきます。シート中のセルの書式やページの設定はBookのデフォルト状態です。
シートの内容を他のシートからコピーして貼り付ける場合は「Add」メソッドを使った場合はセルの書式設定は引き継がれますが、ページ設定は引き継がれません。

「Copy」メソッドを使った場合は、コピー元のシート中のセルの書式やページの設定がすべて引き継がれます。
特に用紙サイズや印刷余白それと印刷範囲設定もコピーされますので、印刷出力する場合には特に便利です。

テンプレートを複製する

VBA

        With wsTMP
            For S = x To 1 Step -1
                Sn = "Ｐ" & S
                .Select
                .Copy after:=wsTMP
                ActiveSheet.Name = Sn
            Next S
        End With

ここでの参考記事

For～Nextのループと入れ子構造をVBA最速理解

シートのコピーを最速に理解！VBAコードで異なる結果

ページごとに注文データを転記

「発注資料表」のページ単位で、複製された注文書テンプレートにデータを転記します。

テンプレートに発注書籍データを転記する

ページ番号が、何らかの原因で消滅してしまった場合は、VBAコードの進行を中止しプログラムから抜けます。

VBA

            Sn = "Ｐ" & S
            For t = 1 To 5
                wbT.Activate
                
                With wsHSD
                    .Select
                    On Error Resume Next
                    PR = WorksheetFunction.Match(Sn, .Columns("A"), 0) + 1
                    If PR = 0 Then
                        MsgBox "FAX発注書の作成でエラーが発生しました。" _
                        & vbCrLf & "発注書作成を再度行なってください。", _
                        vbExclamation, "FAX注文書テンプレート"
                        Exit Sub
                    End If
                    On Error GoTo 0

ここでの参考記事

VBAで使うMatch関数活用度アップでテッパン関数に！

With～End Withの使い方。VBAコードを簡潔に記述する

店番線の挿入の方法

「設定とスタート」シートでの作業

「設定とスタート」シートに、発信元情報の入力表を作成します。

「番線印」についてはそのもの（電子化印）を使用するか、番線印情報を表示するかを選択できるようにします。

注文書テンプレートへの挿入

「番線印」か「番線印情報」は「テンプレート」のコピー各ページに必要分挿入され、「発信元情報」は ” 原紙 ” である「テンプレート」に挿入されます。

番線印のチェックボックスを調べる

「番線印」と「番線印情報」どちらを使うかのチェックマークをチェックしておきます。

VBA

        If wsSST.CheckBoxes(1).Value = xlOn Then
            BNa = 1
        End If
        If wsSST.CheckBoxes(2).Value = xlOn Then
            BNb = 1
        End If
        If BNa = 1 And BNb = 1 Then BNa = 0

ここでの参考記事

シートへの【2種類のチェックボックス】の設置と使い方の違い

番線印を押す

店番線は注文品短冊のそれぞれに押す必要があります。「番線印」と「番線印情報」2つの場合で記述します。

２つともチェックしている場合は「番線印情報」が優先されます。

２つともチェックしていない場合はデータ入力されません。

VBA

                    wbT.Activate
                    Worksheets(Sn).Select
                    
                    If Val(BNa) = 1 Then
                        If SAV > 0 Then
                            wsSST.Range("H13").Copy _
                            Worksheets(Sn).Range(Cells(2, 21 - tt), _
                                                        Cells(2, 24 - tt))
                        End If
                    ElseIf BNb = 1 Then
                        If Val(SAV) > 0 Then
                            wsSST.Range("I13").Copy _
                            Worksheets(Sn).Range(Cells(2, 21 - tt), _
                                                        Cells(2, 24 - tt))
                        Else
                        End If
                    End If

ここでの参考記事

If条件文のVBAコードの組み方。条件の絞り方を最速理解

参考

無料で自作。リアル印鑑をデジタル化してワード・エクセルで使う

あったら助かるモノ・Goods　小さな書店の経営術

参考

無料で使える電子印鑑。使える書類は何？フリーの印鑑ソフトでオススメ7選

あったら助かるモノ・Goods　小さな書店の経営術

発信元情報設置

発信元情報」は ” 原紙 ” である「テンプレート」に挿入します。

VBA

Sub 発信元セット()
    Dim HJa, HJb, HJc, HJd, HJe As Variant
        With wsSST
            .Select
            HJa = .Range("I3")
            HJb = .Range("I4")
            HJc = .Range("I5")
            HJd = .Range("I6")
            HJe = .Range("I7")
        End With
        With wsTMP
            .Select
            .Range("AD10") = HJa
            .Range("AC10") = HJb
            .Range("AB10") = HJc
            .Range("AA10") = HJd
            .Range("Z10") = HJe
        End With
End Sub

送信先FAXNoの挿入の方法

「FAX電話帳.xlsx」の追加作成

FAX電話帳.xlsx」として、出版社などの書籍注文先のFAX番号リストを作ります。エクセルブックを追加してください。

FAX注文書作成のエクセルが保存されている「書籍FAX注文書」フォルダの中に保存します。

シート名を「電話番号」とします。

「電話番号」シートに”見出し”として1行目Ａ列に「出版社名」・Ｂ列に「FAX番号」・Ｃ列に「TEL番号」と入力してください。

FAXNoを注文書へ出力

FAX番号リストより出版社名で抽出して、その結果（FAX番号）をFAX注文書の所定欄に表示します。

FAX電話帳の存在を調べる

所定のフォルダにFAX電話帳があるかどうかを調査します。

もし、存在しない場合は、「存在しない」メッセージを出し、

以降、FAX電話番号を調べて、注文書に出力するVBAコードの実行はスルーされます。

VBA

        FAX = True
        If Dir(wbT.Path & "\FAX電話帳.xlsx") = "" Then
            MsgBox "「FAX電話帳.xlsx」はありませんので、" & vbCrLf & _
            "電話番号検索は行ないません。", vbInformation, _
            "FAX注文書テンプレート"
            FAX = False
        End If

ここでの参考記事

メッセージボックス MsgBox実際の使い方を最速に理解

FAX電話帳が有る場合に番号を検索する

FAX電話帳が存在していた場合は、ブックを開いて、ショッパン社名とマッチングを行い、電話番号を引き出します。

VBA

                    If FAX = True Then
                        Workbooks.Open Filename:=wbT.Path & "\FAX電話帳.xlsx"
                        Worksheets("電話番号").Select
                        On Error Resume Next
                        DR = WorksheetFunction.Match(SUVa, _
                                    Worksheets("電話番号").Columns("A"), 0)
                        On Error GoTo 0
                        If DR <> 0 Then
                            tela = Range("B" & DR)
                            telb = Range("C" & DR)
                            wbT.Activate
                            Worksheets(Sn).Select
                            Range("B12") = "FAX　" & tela
                            Range("A12") = "TEL　" & telb
                        End If
                    End If

ここでの参考記事

ワークブックを開くOpenメソッドの書き方 Excelマクロ

VBAで使うMatch関数活用度アップでテッパン関数に！

利用済データ、FAX注文書のクリアと削除

「テンプレート」のコピー各ページと「発注資料表」の内容がクリアーします。

” 原紙 ” である「テンプレート」に挿入された「発信元情報」は消去されません。消去するには「設定とスタート」シートの「発信元情報」欄の入力情報を別に消去します。

発注資料表からシートの展開状況を判断する

発注資料表で何ページ分のデータが入力されているかを調べます。

VBAコード本体部の発注資料表のN列の「〇」の最終行を調べると同じコードになります。

VBA

        wsHSD.Select
        Nrow = Cells(Rows.Count, 13).End(xlUp).Row
        e = Nrow Mod 9
        ee = Nrow \ 9
        If ee = 0 Then
            If e < 3 Then
              wsSST.Select
              Range("A1").Select
              Exit Sub
            Else
               x = 1
            End If
        Else
            x = ee + 1
        End If

追加したテンプレートシートを削除する

追加した出版社別FAX注文書を削除します。

「Ｐ1～のシート名」のシートを削除します。追加作成した数だけのページ番号のシート名があります。

ここでの参考記事

エクセルシートを削除する。Deleteの使い方と注意ポイント

‘発注資料表をクリアする

シートをデフォルトの状態に戻します。

ここでの参考記事

シートクリアーを目的のメソッド別にVBA最速理解