エクセルVBAで作るFAX注文書の最終作成作業です。
第3回目作成のテンプレートに「書籍データ」「店番線」「送信先FAXNo」のデータを入力します。
こんにちは、じゅんぱ店長（@junpa33）です。
テンプレートを複製して出版社別の注文書シートを完成させます。
「FAX注文書テンプレート.xlsm」での作業を中心に行います。
テンプレートを出版社別に複製して、「書籍データ」「店番線」「送信先FAXNo」を各シートに挿入します。
「書籍データ」は発注資料表より、「店番線」は設定とスタートより、「送信先FAXNo」は別ブックのFAX電話帳からのデータ入手を行います。
ＦＡＸ注文書作成の記事編成
- FAX注文書作成ツールの使い方とダウンロード
コンテンツ
FAX注文書を完成させるVBA全コード
ここで菅亞聖させるVBAコードは4つのブロック（プロシージャー）で構成しています。
ブックとシートオブジェクトを頻繁に指定していきますので、略語の様な使い方で、変数に代入しておきます。
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
FAX注文書を作成するための中心となる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
注文元（自店）の情報を転記します。
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
次回利用のため、使用済データをクリア・削除します。
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プロシージャーでブックとシートのオブジェクトを変数に代入するコードを作成しておきます。
これにより以降は、変数でオブジェクトを表すことが出来ます。
書籍データ入力に関わるコード
「テンプレート」シートの注文書テンプレートは ” 原紙 ” となります。
適宜、コピーをして使用します。コピーの枚数は、「発注資料表」に表示されているページ数分となります。
コピーしたテンプレートのシート名を「P1～」と名付けます。
「Add」メソッドは名前の通りシートを追加します。この場合はSheet4，Sheet5と増えていきます。シート中のセルの書式やページの設定はBookのデフォルト状態です。
シートの内容を他のシートからコピーして貼り付ける場合は「Add」メソッドを使った場合はセルの書式設定は引き継がれますが、ページ設定は引き継がれません。
「Copy」メソッドを使った場合は、コピー元のシート中のセルの書式やページの設定がすべて引き継がれます。
特に用紙サイズや印刷余白それと印刷範囲設定もコピーされますので、印刷出力する場合には特に便利です。
With wsTMP
For S = x To 1 Step -1
Sn = "Ｐ" & S
.Select
.Copy after:=wsTMP
ActiveSheet.Name = Sn
Next S
End With
「発注資料表」のページ単位で、複製された注文書テンプレートにデータを転記します。
ページ番号が、何らかの原因で消滅してしまった場合は、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店番線の挿入の方法
「設定とスタート」シートに、発信元情報の入力表を作成します。
「番線印」についてはそのもの（電子化印）を使用するか、番線印情報を表示するかを選択できるようにします。
「番線印」か「番線印情報」は「テンプレート」のコピー各ページに必要分挿入され、「発信元情報」は ” 原紙 ” である「テンプレート」に挿入されます。
「番線印」と「番線印情報」どちらを使うかのチェックマークをチェックしておきます。
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つの場合で記述します。
２つともチェックしている場合は「番線印情報」が優先されます。
２つともチェックしていない場合はデータ入力されません。
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
発信元情報」は ” 原紙 ” である「テンプレート」に挿入します。
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番号リストを作ります。エクセルブックを追加してください。
FAX注文書作成のエクセルが保存されている「書籍FAX注文書」フォルダの中に保存します。
シート名を「電話番号」とします。
「電話番号」シートに”見出し”として1行目Ａ列に「出版社名」・Ｂ列に「FAX番号」・Ｃ列に「TEL番号」と入力してください。
FAX番号リストより出版社名で抽出して、その結果（FAX番号）をFAX注文書の所定欄に表示します。
所定のフォルダにFAX電話帳があるかどうかを調査します。
もし、存在しない場合は、「存在しない」メッセージを出し、
以降、FAX電話番号を調べて、注文書に出力するVBAコードの実行はスルーされます。
FAX = True
If Dir(wbT.Path & "\FAX電話帳.xlsx") = "" Then
MsgBox "「FAX電話帳.xlsx」はありませんので、" & vbCrLf & _
"電話番号検索は行ないません。", vbInformation, _
"FAX注文書テンプレート"
FAX = False
End If
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利用済データ、FAX注文書のクリアと削除
「テンプレート」のコピー各ページと「発注資料表」の内容がクリアーします。
” 原紙 ” である「テンプレート」に挿入された「発信元情報」は消去されません。消去するには「設定とスタート」シートの「発信元情報」欄の入力情報を別に消去します。
発注資料表で何ページ分のデータが入力されているかを調べます。
VBAコード本体部の発注資料表のN列の「〇」の最終行を調べると同じコードになります。
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～のシート名」のシートを削除します。追加作成した数だけのページ番号のシート名があります。
シートをデフォルトの状態に戻します。
マクロ実行のコマンドボタンを設置
「設置とスタート」シートにVBAコード起動用のボタンを設置します。
まとめ
これで作業は完了です。
最後の調整として、発注書の表示で見づらいところを書式設定で適切化することになります。
次回は最後の記事となります。
表示についての調節と、使い方の説明を、ツールのダウンロードの案内を行います。
短期間でエクセルVBAの独学習得を目指したいなら
エクセルVBAを独学する独習方法は、学習者それぞれ十人十色、多種多様と思われます。
けれども、
出来るだけ効率よく学習するためには、いくつかの大切なポイントがあります。
独学でもVBA習得の中級クラスに達するのはそんなに難しいことではありません。
先人が行った勉強方法をあなたがそのまま利用すればよいということです。
エクセルVBAを独学で習得する！ために大切な7つのポイントを解説します
独習のための大切な7つのポイントは、上記記事にて解説しています。
独習によるVBA習得のキーワードは、
出来るだけ多くの実例に触れること！
です。
正直、VBAの学習について自分の周りの仕事（業務）からだけ実例を得るのでは効率良い習熟は無理です。
ハッキリ言って、
本当に短い期間でVBA習得を成功させたいなら、今使っている参考書が良書かどうかを判断し、新ツールとしてオンライン学習も取り入れて行うことが、
手っ取り早く短期間習得できるというのは間違いないでしょう。
エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。
エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です
今回の記事はここまでです。 最後までご覧いただき有難うございました。
