閲覧くださいまして、ありがとうございます。
よろしくお願いします。
現在、サイトを参考にexcelで請求書を発行するマクロを組んでおります。
月別かつクライアント別かつ納品日別にしたいと思っておりますが、納品日別にすることができません。
今できていること
・9月で検索すると納品日が9月以降10月未満のデータが出てくる
・それらをクライアントごとに分けて請求書を発行
できないこと
・同じ月にいくつも納品日があるクライアント様の請求書が1枚にまとめられてしまう→別々にしたい
どうか、よろしくお願いします。
自分なりにいじってしまったので、コードが汚くて本当にすみません。
【納品データ】
納品日 | 取引先名 | 商品詳細 | 商品タイトル | 数量 | 単価 | 金額 | 請求書発行日 |
---|
【取引先一覧】
|取引先名|郵便番号|住所1|住所2|源泉徴収税表記有/無|
|:--|:--:|--:|--:|--:|--:|--:|--:|
Option Explicit
Public wsData As Worksheet '「請求データ」シートを入れるオブジェクト変数
Public wsInvoice As Worksheet '「請求書ひな形」シートを入れるオブジェクト変数
Public wsClient As Worksheet '「取引先一覧」シートを入れるオブジェクト変数
Public rowsData As Long '「請求データ」の行数
Public rowsClient As Long '「取引先一覧」の行数
Sub シート初期化()
Set wsData = ThisWorkbook.Worksheets("納品データ")
Set wsInvoice = ThisWorkbook.Worksheets("請求書雛形")
Set wsClient = ThisWorkbook.Worksheets("取引先一覧")
rowsData = wsData.Cells(Rows.Count, 2).End(xlUp).Row '最後の行数を取得
rowsClient = wsClient.Cells(Rows.Count, 1).End(xlUp).Row '「取引先マスタ」の最後の行数を取得
wsInvoice.Rows("21:50").Hidden = False '隠れている行を再表示する
wsInvoice.Rows("44:47").Hidden = False '隠れている行を再表示する
wsInvoice.Range("B22:D41").ClearContents 'ここに転記先のセル範囲のクリアを入れる
End Sub
Sub 請求書作成()
Dim j As Long, i As Long, n As Long, m As Long, b As Long, c As Long, k As Long, h As Long, p As Long, f As Long
Dim dayData As Date '納品日格納用変数
Dim dayCutoff As Date '締月入力用変数
Dim strClient As String '取引先格納用変数
Dim g As Long
dayCutoff = InputBox("締月を入力してください(例:2016/9)")
Call シート初期化
p = 1
For h = 2 To rowsClient
If WorksheetFunction.SumIfs( _ wsData.Range("G:G"), _ wsData.Range("H:H"), "", _ wsData.Range("A:A"), ">=" & dayCutoff, _ wsData.Range("A:A"), "<" & DateAdd("m", 1, dayCutoff), _ wsData.Range("B:B"), wsClient.Cells(h, 1).Value _ ) > 0 Then
Workbooks.Add '新規ワークブックを作成
ThisWorkbook.Worksheets("請求書雛形").Copy before:=ActiveWorkbook.Sheets(1) '新規ワークブックのsheet1の前にひな形をコピー
Set wsInvoice = ActiveSheet 'コピーしたシートを変数にセット wsInvoice.Name = "請求書" 'シート名を変更
n = 1
c = 0
k = 0
m = 2
For i = 2 To rowsData dayData = wsData.Cells(m, 1).Value '現在の行の納品日を取得 strClient = wsData.Cells(m, 2).Value If wsData.Cells(m, 8).Value = "" Then
If strClient = wsClient.Cells(h, 1).Value Then
If Year(dayData) = Year(dayCutoff) And Month(dayData) = Month(dayCutoff) Then '年が2017でかつ月が9かつ日にちが12の場合は処理を実行
For b = 2 To 5 '納品データを転記 wsInvoice.Cells(22 + k + n, b - c).Value = wsData.Cells(i, b + 1).Value c = 1 n = 0 Next b n = 1 k = k + 2 c = 0 If wsData.Cells(i, 8).Value = "" Then wsData.Cells(i, 8).Value = Format(Date, "yyyymmdd") End If End If End If End If m = m + 1
Next i
wsInvoice.Rows(22 + k & ":41").Hidden = True 'データがない行を隠す
wsInvoice.Cells(8, 2).Value = wsClient.Cells(h, 2).Value wsInvoice.Cells(9, 2).Value = wsClient.Cells(h, 3).Value wsInvoice.Cells(10, 2).Value = wsClient.Cells(h, 4).Value wsInvoice.Cells(11, 2).Value = wsClient.Cells(h, 1).Value
wsInvoice.Range("E1").Value = "請求番号:" & (Format(Date, "yyyymmdd")) & "-" & (Format(p, "000"))
If IsEmpty(wsClient.Cells(h, 5)) Then '源泉徴収税のセルが不要ならば wsInvoice.Rows(44 & ":47").Hidden = True '源泉徴収税、差引額のセルを消す wsInvoice.Range("B16").Value = "ご請求金額 ¥" & Format(wsInvoice.Cells(42, 5).Value, "#,###,##0") & " -" Else: wsInvoice.Range("B16").Value = "ご請求金額 ¥" & Format(wsInvoice.Cells(46, 5).Value, "#,###,##0") & " -" End If Dim strFile As String '保存先フォルダパス&ファイル名(拡張子抜き) strFile = ThisWorkbook.Path & "\" & wsClient.Cells(h, 1).Value & "_" & (Format(Date, "yyyymmdd")) & "_" & (Format(p, "000"))
wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力
'PDF出力設定
With wsInvoice.PageSetup
.Zoom = False '倍率をクリア .FitToPagesWide = 1 '横方向に1ページに収める .FitToPagesTall = 1 '縦方向に1ページに収める .CenterHorizontally = True '水平方向に中央配置 .TopMargin = Application.CentimetersToPoints(1) '上マージンを1cm .BottomMargin = Application.CentimetersToPoints(1) '下マージンを1cm End With wsInvoice.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf" '選択したシートをPDF出力 ActiveWorkbook.Close savechanges:=True, Filename:=strFile & ".xlsx" 'アクティブブックを名前を付けて保存して閉じる
p = p + 1
End If
Next h
End Sub

回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2017/02/28 13:16
2017/03/01 01:54
2017/03/02 03:58