請求書を作成します
作成方法は３パターン
①同ブックに別シートとして請求書を作成する
②作成する請求書を別ブックとする
③売上データ・作成する請求書を別ブックとする
YouTubeで売上明細を作成する動画を作りましたが、
これを応用して請求書作ることができます
売上明細処理は、すでにあるシートに売り上げデータを転記するプログラムですが、
今回は、この売上明細処理にシートを追加する処理を加えました
売上明細作成のプログラム
Sub Uriage_Keisan()
Dim Tenmei As String '作成する店名 文字列
Dim i As Long '売上データの行数
Dim j As Long '作成する売上表の行数
Dim k As Long '売上の項目の位置(列)
Dim SaisyuGyo As Long '売上データの最終行
'Application.ScreenUpdating = False '画面の更新を止める
'ちらつき防止
Call Sheet_Clear '全店名別シートのClear
With Worksheets("売上明細")
SaisyuGyo = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 3 To SaisyuGyo
Tenmei = .Cells(i, 3)
'売上表に転記
Worksheets(Tenmei).Activate
j = Cells(Rows.Count, 2).End(xlUp).Row
For k = 4 To 7
Cells(j + 1, k - 2) = .Cells(i, k) '商品名～金額
Next k
Next i
End With
Worksheets("売上明細").Activate
'Application.ScreenUpdating = True '画面の更新を再開する
End Sub
Sub Sheet_Clear() '全店名別シートのClear
Dim Tenmei As String '作成する店名 文字列
Dim Tenmei_No As Long '店名一覧の行数
For Tenmei_No = 3 To 7
Tenmei = Worksheets("店名一覧").Cells(Tenmei_No, 2)
With Worksheets(Tenmei)
'5行目以降をすべて消去
.Rows("5:" & Rows.Count).ClearContents
'5行目以降最終行まで消去するなら
' .Rows("5:" & .Cells(Rows.Count, 3).End(xlUp).Row) _
' .ClearContents
End With
Next Tenmei_No
End Subシートの追加
売上明細処理のデータを転記する前にこのフローチャートのプログラムを加えます
指定会社名のシートがなければシートを追加し、あれば指定シートをアクティブします
Sheet_ClearとKaisyaJyouhouプロシージャ
Sheet_Clearは、
作り直しました
顧客マスターから
Kaisyameiを取り出し、
そのシートがあれば、
そのシートの明細行のみをClearします
(シートの有無の判断は、
シートの追加と同じ)
次のシート検索のために、
オブジェクト変数をクリア
請求書作成の先頭で、
このプロシージャを呼び出す
引数はKaisyamei
顧客マスターからKaisyameiを検索し、そのデータをアクティブシートに代入する
シート作成時に呼び出す
パターン１プログラム
'売上明細→同ブック全会社請求書
Sub Seikyusyo_Sakusei0()
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 '全請求書シートの明細消去
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 'シートなければ、作成する
Worksheets("請求書ひな形").Copy after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = Kaisyamei
Call KaisyaJyouhou(Kaisyamei) '会社情報転記（請求書Header）
Else
Worksheets(Kaisyamei).Activate 'シートあれば、アクティブに
Set WS = Nothing 'オブジェクト変数をクリア
End If
On Error GoTo 0 'エラー処理を戻す
' ここまで ↑
'*****************************
'請求書に転記
j = Cells(29, 2).End(xlUp).Row '請求書最終行
For k = 4 To 6
Cells(j + 1, k - 2) = .Cells(i, k) '最終行+1へ追加
Next k
Next i
End With
'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で、前に記入した明細をClear
明細だけを削除するので、その会社のデータがない時も、空の請求書（明細のない）ができる
なので、Sheet_Clearで全会社シートを削除しても…
このほうがよかったね(^^;)
コメント