請求書を作成します
作成方法は３パターン
①同ブックに別シートとして請求書を作成する
②作成する請求書を別ブックとする
③売上データ・作成する請求書を別ブックとする
パターン②-1
作成する請求書を別ブックとする
パターン①（同ブックに別シートとして請求書を作成する）に
ブックがない場合はブックを追加する処理を加える
作成する請求書ブックは年月別とする
実行ファイルと
作成する請求書を
別ブックとする
顧客マスターには、
会社情報（住所や電話番号等)が入っている
売上データは、作成する
請求書のひと月分のデータ
選択シートで作成する年月を入力
作成ボタンで請求書作成
年と月を引数として請求書作成処理に渡す
年月はデータの入力規制で
入力値の種類をリストとし、
参照する値（元の値）を
範囲指定
指定した後は年月の列を
非表示にする
Sub 請求書作成処理2_1()
Dim Nen As Long '請求書の年
Dim Tuki As Long '請求書の月
Nen = ThisWorkbook.Worksheets("選択").Range("d5")
Tuki = ThisWorkbook.Worksheets("選択").Range("d7")
Call Seikyusyo_Sakusei1(Nen, Tuki)
End Subパターン①のプログラム
Sub Seikyusyo_Sakusei()
Dim Kaisyamei As String '作成する会社名 文字列
Dim i As Long '売上データの行数
Dim j As Long '作成する売上表の行数
Dim k As Long '売上の項目の位置(列)
Dim SaisyuGyo As Long '売上データの最終行
Dim WS As Worksheet 'ワークシートオブジェクト変数
'Application.ScreenUpdating = False '画面の更新を止める
'ちらつき防止
Call Sheet_Clear '請求書シートのClear
With Worksheets("売上明細")
SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 3 To SaisyuGyo
Kaisyamei = .Cells(i, 3)
'*****************************
' 会社名の請求書シートがあるかどうか？
On Error Resume Next 'エラーがあっても次に進む
Set WS = Worksheets(Kaisyamei)
If WS Is Nothing Then 'シートなければ、作成する
Worksheets("請求書ひな形").Copy after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Kaisyamei
Call KaisyaJyouhou(Kaisyamei) '会社情報転記
Else
Worksheets(Kaisyamei).Activate 'シートあれば、アクティブに
Set WS = Nothing 'オブジェクト変数をクリア
End If
On Error GoTo 0 'エラー処理を戻す
'*****************************
'請求書に転記
j = Cells(Rows.Count, 2).End(xlUp).Row
For k = 4 To 6
Cells(j + 1, k - 2) = .Cells(i, k) '商品名～単価
Next k
Next i
End With
Worksheets("選択").Activate
'Application.ScreenUpdating = True '画面の更新を再開する
End Sub
Sub Sheet_Clear()
Dim SaisyuGyo As Long, Gyo As Long, i As Long
Dim Kaisyamei As String
Dim WS As Worksheet
Dim KM As Worksheet
Set KM = Worksheets("顧客マスター")
'顧客マスター最終行
SaisyuGyo = KM.Cells(Rows.Count, 2).End(xlUp).Row
'顧客マスター最終行までループ
For i = 3 To SaisyuGyo
Kaisyamei = KM.Cells(i, 2)
On Error Resume Next 'エラーがあっても次に進む
Set WS = Worksheets(Kaisyamei)
On Error GoTo 0 'エラー処理を戻す
'シートがあるかないか判断
If Not (WS Is Nothing) Then
'ワークシートがあればアクティブに
Worksheets(Kaisyamei).Activate
'取り出すシートの最終行
Gyo = Cells(29, 2).End(xlUp).Row
'データがある場合のみ、Clearする
If Gyo >= 16 Then
'16行目から最終行まで表の範囲を消去
Range(Cells(16, 1), Cells(Gyo, 4)).ClearContents
End If
Set WS = Nothing
End If
Next i
End Sub
Sub KaisyaJyouhou(Kaisyamei As String)
Dim i As Long, SaisyuGyo As Long
Dim KM As Worksheet
Set KM = Worksheets("顧客マスター")
SaisyuGyo = KM.Cells(Rows.Count, 3).End(xlUp).Row '顧客マスター最終行
'会社情報転記
For i = 3 To SaisyuGyo
If Kaisyamei = KM.Cells(i, 2) Then
Range("a2") = Kaisyamei
Range("a3") = "〒" & KM.Cells(i, 3) '〒
Range("a4") = KM.Cells(i, 4) '住所
Range("a5") = "TEL：" & KM.Cells(i, 5) '電話番号
Exit For
End If
Next i
End Subブックの追加
パターン①の初めにこのフローチャートのプログラムを加えます
指定年月のブックがあればブックを開き、なければ新規ブックを作成し名前を付けます
冒頭に呼び出していたSheet_Clearプロシージャを
ブックをOpenした後に呼び出す
（新規ブックはClearする必要がないので）
ブックがない場合はブックを追加し、ある場合はそのブックをOpenする処理を加える
新規ブック作成
Dir関数
書き方 Dir（ファイル名）
引数のファイルが存在すると、そのファイル名を返し、
存在しないと空欄を返す
(引数はフルパスで指定、戻り値はファイル名のみ)
'*****************************
'ブックの作成＆Open
'*****************************
Dim Filename As String '作成する請求書名
Filename = ThisWorkbook.Path & "\請求書データ\請求書" & Nen & Format(Tuki, "00") & ".xlsx"
If Dir(Filename) <> "" Then
Workbooks.Open Filename 'ブックがある時
Call Sheet_Clear '全シートの明細消去
Else
Worksheets("請求書ひな形").Copy 'ブックがない時 ブックを作成
ActiveWorkbook.SaveAs Filename 'ブックに名前を付ける
End IfSheet_Clear
請求書のファイルを別ブックとしたので、
ブックすべてのシートをClearする処理に変更
(顧客マスターを参照しなくてもOK)
For Eachですべてのシートがなくなるまで、Clear処理を行う
変更前 パターン①のSheet_Clear
Sub Sheet_Clear() '顧客マスターにある会社名のシートがあればそのシートの明細消去
Dim SaisyuGyo As Long, Gyo As Long, i As Long
Dim Kaisyamei As String
Dim WS As Worksheet '取り出すWorksheetのオブジェクト変数
Dim KM As Worksheet '顧客マスターのオブジェクト変数
Set KM = Worksheets("顧客マスター")
'顧客マスター最終行
SaisyuGyo = KM.Cells(Rows.Count, 2).End(xlUp).Row
'顧客マスター最終行までループ
For i = 3 To SaisyuGyo
Kaisyamei = KM.Cells(i, 2)
On Error Resume Next 'エラーがあっても次に進む
Set WS = Worksheets(Kaisyamei)
On Error GoTo 0 'エラー処理を戻す
'シートがあるかないか判断
If Not (WS Is Nothing) Then
'ワークシートがあればアクティブに
Worksheets(Kaisyamei).Activate
'取り出すシートの最終行
Gyo = Cells(29, 2).End(xlUp).Row
'データがある場合のみ、Clearする
If Gyo >= 16 Then
'16行目から最終行まで表の範囲を消去
Range(Cells(16, 1), Cells(Gyo, 4)).ClearContents
End If
Set WS = Nothing
End If
Next i
End Sub
↓
パターン②のSheet_Clear
Sub Sheet_Clear() '請求書ブックの全シートの明細消去
Dim Gyo As Long
Dim WS As Worksheet '取り出すWorksheetのオブジェクト変数
For Each WS In Worksheets
'WS.Activate
Gyo = WS.Cells(29, 2).End(xlUp).Row '取り出すシートの最終行
'データがある場合のみ、Clearする
If Gyo >= 16 Then
'16行目から最終行まで表の範囲を消去
WS.Range(WS.Cells(16, 1), WS.Cells(Gyo, 4)).ClearContents
End If
Next WS
End Sub
シートの指定
①WS.Activateにするか、あるいは セル指定の前に②WS.を付けます
アクティブブックは請求書ですが、シートは指定する必要があります
①②どちらか好きな方で～
ThisWorkbookの指定
実行ファイル（ThisWorkbook）にあるシートは、ThisWorkbookを指定する必要あり！
ActiveBookは請求書です！
ブックを指定しないシート・セルなどの指定は、すべて請求書ブックを指します
パターン②-1 プログラム
Option Explicit
Sub 請求書作成処理2_1()
Dim Nen As Long '請求書の年
Dim Tuki As Long '請求書の月
Nen = ThisWorkbook.Worksheets("選択").Range("d5")
Tuki = ThisWorkbook.Worksheets("選択").Range("d7")
Call Seikyusyo_Sakusei1(Nen, Tuki)
End Sub
Sub Seikyusyo_Sakusei1(Nen As Long, Tuki As Long)
Dim Kaisyamei As String '作成する会社名 文字列
Dim i As Long '売上データの行数
Dim j As Long '作成する売上表の行数
Dim k As Long '売上の項目の位置(列)
Dim SaisyuGyo As Long '売上データの最終行
Dim WS As Worksheet 'ワークシートオブジェクト変数
Application.ScreenUpdating = False '画面の更新を止める
'ちらつき防止
'*****************************
'この部分を加える ↓
'*****************************
'ブックの作成＆Open
'*****************************
Dim Filename As String '作成する請求書名
Filename = ThisWorkbook.Path & "\請求書データ\請求書" & Nen & Format(Tuki, "00") & ".xlsx"
If Dir(Filename) <> "" Then
Workbooks.Open Filename 'ブックがある時
Call Sheet_Clear '全シートの明細消去
Else
ThisWorkbook.Worksheets("請求書ひな形").Copy 'ブックがない時 ブックを作成
ActiveWorkbook.SaveAs Filename 'ブックに名前を付ける
End If
' ここまで ↑
'*****************************
'*****************************
'請求書作成
'*****************************
With ThisWorkbook.Worksheets("売上明細")
SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 3 To SaisyuGyo
Kaisyamei = .Cells(i, 3)
'*****************************
' 会社名の請求書シートがあるかどうか？
On Error Resume Next 'エラーがあっても次に進む
Set WS = Worksheets(Kaisyamei)
If WS Is Nothing Then 'シートなければ、作成する
ThisWorkbook.Worksheets("請求書ひな形").Copy after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Kaisyamei
Call KaisyaJyouhou(Kaisyamei) '会社情報転記
Else
Worksheets(Kaisyamei).Activate 'シートあれば、アクティブに
Set WS = Nothing 'オブジェクト変数をクリア
End If
On Error GoTo 0 'エラー処理を戻す
'*****************************
'売上表に転記
j = Cells(Rows.Count, 2).End(xlUp).Row
For k = 4 To 6
Cells(j + 1, k - 2) = .Cells(i, k) '商品名～単価
Next k
Next i
End With
ActiveWorkbook.Close savechanges:=True '変更があれば、保存
ThisWorkbook.Worksheets("選択").Activate
MsgBox "請求書作成しました"
Application.ScreenUpdating = True '画面の更新を再開する
End Sub
Sub Sheet_Clear()
Dim Gyo As Long
Dim WS As Worksheet '取り出すWorksheetのオブジェクト変数
'シートがなくなるまでループ
For Each WS In Worksheets
'ワークシートをアクティブに
'WS.Activate
'取り出すシートの最終行
Gyo = WS.Cells(29, 2).End(xlUp).Row
'データがある場合のみ、Clearする
If Gyo >= 16 Then
'16行目から最終行まで表の範囲を消去
WS.Range(WS.Cells(16, 1), WS.Cells(Gyo, 4)).ClearContents
End If
Next WS
End Sub
Sub KaisyaJyouhou(Kaisyamei As String)
Dim i As Long, SaisyuGyo As Long
Dim KM As Worksheet
Set KM = ThisWorkbook.Worksheets("顧客マスター")
SaisyuGyo = KM.Cells(Rows.Count, 3).End(xlUp).Row '顧客マスター最終行
'会社情報転記
For i = 3 To SaisyuGyo
If Kaisyamei = KM.Cells(i, 2) Then
Range("a2") = Kaisyamei
Range("a3") = "〒" & KM.Cells(i, 3) '〒
Range("a4") = KM.Cells(i, 4) '住所
Range("a5") = "TEL：" & KM.Cells(i, 5) '電話番号
Exit For
End If
Next i
End Sub
コメント