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

datatenkieyecatch

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

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

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

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

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

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

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

datatenki009

ここで菅亞聖させる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 "作成するFAX注文書はありません。", 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 = "P" & 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 = "P" & 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)
            'ISBN
                    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) = "ISBN " & 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 = "P" & 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

記述コードの解説

datatenki010

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

モジュールの先頭部分

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

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

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

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

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

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

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

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

MEMO

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


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

テンプレートを複製する

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

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

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

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

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

VBA
            Sn = "P" & 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
        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つともチェックしている場合は「番線印情報」が優先されます。

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

発信元情報設置

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

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
datatenki003a

送信先FAXNoの挿入の方法

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

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

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

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

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

faxsiage001a

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

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

利用済データ、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注文書を削除します。

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

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

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

マクロ実行のコマンドボタンを設置

「設置とスタート」シートにVBAコード起動用のボタンを設置します。

datatenki008a

まとめ

datatenki011

これで作業は完了です。

最後の調整として、発注書の表示で見づらいところを書式設定で適切化することになります。

次回は最後の記事となります。

表示についての調節と、使い方の説明を、ツールのダウンロードの案内を行います。

短期間でエクセルVBAの独学習得を目指したいなら

エクセルVBAを独学する独習方法は、学習者それぞれ十人十色、多種多様と思われます。

けれども、

出来るだけ効率よく学習するためには、いくつかの大切なポイントがあります。

独学でもVBA習得の中級クラスに達するのはそんなに難しいことではありません。

先人が行った勉強方法をあなたがそのまま利用すればよいということです。

vbastudyeyecatch002 エクセルVBAを独学で習得する!ために大切な7つのポイントを解説します

独習のための大切な7つのポイントは、上記記事にて解説しています。

独習によるVBA習得のキーワードは、

出来るだけ多くの実例に触れること!

です。

正直、VBAの学習について自分の周りの仕事(業務)からだけ実例を得るのでは効率良い習熟は無理です。

ハッキリ言って、

本当に短い期間でVBA習得を成功させたいなら、今使っている参考書が良書かどうかを判断し、新ツールとしてオンライン学習も取り入れて行うことが、

手っ取り早く短期間習得できるというのは間違いないでしょう。

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう!

エクセルVBA業務ツールで日常の業務改善を行いましょう。

VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。