[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAを使った領収書作成』(キルチ)
領収書を自動で印刷するマクロを作っています。
個別操作では色々作れているのですが、ところどころわからないところがあります。
【入力シート】
自動ID 発行日 宛先 件名 手数料 事務手数料
6 2018/4/18 田中 机代 5000 600
7 2018/4/26 舟橋 旅行費 50000 1280
というように続きます。(手数料のほかにも項目はあります)
自動IDは前回つくったデータから参照します。
作りたい流れとしては、
◆【入力シート】入力されていればその行に自動IDを振る
◆【入力シート】入力されたデータを1セルごとにコピーし【印刷シート】にある領収書に合うセルにそれぞれ貼り付け(数値を文字列にしないとはみ出した時に###となってしまう)
◆【印刷シート】印刷・またはPDFに保存(名前は発行日+領収書+自動ID)
◆【印刷シート】内の入力されたセルを空欄に戻す
◆【入力シート】下の行に移動し同様の処理、入力された最後までループ
◆【入力シート】最終行までいったら入力シートをコピー【過去発行分】最終行に張り付け
◆【入力シート】の中身を削除
◆【入力シート】入力されていればその行に自動IDを振る
Sub 連番を入力する()
Dim rng As Range Dim i As Long Dim N As String Dim b As String Dim LstRow1 As Long Dim LstRow2 As Long Dim cell1 As Long Dim cell2 As Long b = Cells(2, 1) N = Cells(Rows.Count, "B").End(xlUp).Row 'B列の最終行 Range(Cells(2, 2), Cells(N, 2)).Offset(0, -1).Select 'B列の最終行から選択範囲を作ってA列に移動 i = Range("P1") + 1 '過去の最終番号を表示 For Each rng In Selection rng.Value = i i = i + 1 Next End Sub
◆【入力シート】入力されたデータを1セルごとにコピーし【印刷シート】合うセルにそれぞれ貼り付け(数値を文字列にしないとはみ出した時に###となってしまう)
不明
◆【印刷シート】印刷・またはPDFに保存(名前は発行日+領収書+自動ID)
Sub 印刷()
Sheets("印刷シート").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False End Sub
Sub PDFで出力()
Dim wsInvoice As Worksheet
Dim PdfName As String
Dim PdfNo As String
PdfName = Cells(6, 9).Value
PdfNo = Cells(4, 16).Value
Sheets("印刷シート").Select
Application.DisplayAlerts = False '確認メッセージをオフにする Dim strFile As String '保存先フォルダパス&ファイル名(拡張子抜き) strFile = "C:\領収書\" & PdfNo & "-領収書-" & PdfName ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=False '選択したシートをPDF出力 End Sub
◆【印刷シート】内の入力されたセルを空欄に戻す
不明
◆【入力シート】下の行に移動し同様の処理、入力された最後までループ
不明
◆【入力シート】最終行までいったら入力シートをコピー【過去発行分】最終行に張り付け
Sub コピーして貼り付け()
'変数の宣言
Dim LstRow1 As Long Dim LstRow2 As Long LstRow1 = Worksheets("入力シート").Cells(Rows.Count, 1).End(xlUp).Row LstRow2 = Worksheets("過去発行分").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("入力シート").Range("A2:L" & LstRow1).Copy Worksheets("過去発行分").Range("A" & LstRow2).Offset(1, 0).PasteSpecial xlPasteAll Sheets("入力シート").Activate End Sub
◆【入力シート】の中身を削除
不明
とここまで作りましたが、不明点が多く先に進めません。
部分的でもいいのでわかるところがあればご教示頂きたいです。
< 使用 Excel:Excel2016、使用 OS:Windows10 >
コード拝見させていただきました。 ただ、入力シートと印刷シートの構成がわからないのでコメント難しいです。 [[20110209184943]] 『[談]シートレイアウトの投稿どうしてますか?』(momo) こちらを使って、それぞれセル番地を教えていただけませんか? (稲葉) 2019/04/16(火) 12:26
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H]|[I] |[J] [1] |自動ID|発行日 |宛先|件名 |手数料|事務手数料|その他| |前回のID| 11 [2] | 12|2019年8月25日|高橋|〇〇について|10,000| 10,004| | | | [3] | 13|2019年8月25日|田中|〇〇について|10,002| 10,002|10,002| | | [4] | 14|2019年8月26日|船橋|〇〇について|10,004| |10,004| | | [5] | 15|2019年8月27日|高橋|手数料送付 |10,006| 10,006|10,006| | | [6] | 16|2019年8月28日|田中|〇〇について|10,008| 10,008|10,008| | | [7] | 17|2019年8月29日|船橋|〇〇について|10,010| 10,010|10,010| | | [8] | 18|2019年8月30日|高橋|納付 |10,012| 10,012|10,012| | | [9] | 19|2019年8月31日|田中|〇〇について|10,014| 10,014|10,014| | | [10]| 20|2019年9月1日 |船橋|〇〇について|10,016| 10,016|10,016| | | [11]| 21|2019年9月2日 |高橋|〇〇について|10,018| 10,018|10,018| | | [12]| 22|2019年9月3日 |田中|〇〇について|10,018| 10,018|10,018| | |
[印刷シート] |[E] |[F] |[G]|[H] |[I] |[J] |[K]|[L] |[M]|[N]|[O] |[P]|[Q] |[R] [5] | | | |領 収 書| | | | | | | |No.| 12| [6] | | | | |高橋|様 | | | | |### | | | [7] | | | | | | | | | | | | | | [8] | |金 額 | | | |百万 | | |千 | | |円 | | [9] | | | | | | | | 3| 0| 0| 1| 2| | [10]| |件名:|〇〇について | | | | | | | | | | | [11]| | | | | | | | | | | | | | [12]|内訳 | | |金額 | |消費税| |内訳| | |金額| |消費税| [13]|手数料 | | |10,000 | | 800| | | | | | | | [14]|事務手数料| | |10,004 | | 800| | | | | | | | [15]|その他 | | | | | 800| | | | | | | |
印刷シートのほうは多少崩れてしまいますがこんな感じです。
以下が印刷シートのセル内容になります。
Q5…自動ID
I6…宛先
O6…年月日
H~P9…合計金額を位別に分けて表示
H10…件名
H13…手数料
J13…手数料消費税
H14…事務手数料
J14…事務手数料消費税
H15…その他
J15…その他消費税
(キルチ) 2019/04/16(火) 13:29
印刷シートの各項目は、Q5のNoを検索値にして、VLOOKUP処理が簡単でいいと思います。 なので、Q5を書き換える処理だけにしました。 >(数値を文字列にしないとはみ出した時に###となってしまう) こちらについては、セルの書式設定で「対象を縮小して表示」が無難かと思われます。 どうしても文字にしたい場合は、=TEXT(VLOOKUP(Q5,入力シート!A:J,〜〜,0),"#,##")のように、数式で 文字列にしてしまってもよいかと思います。
Sub 連番を入力する() Dim ipWS As Worksheet Dim opWS As Worksheet Dim lgWS As Worksheet Dim opType As String Dim i As Long, fn As String '印刷方法の選択 opType = InputBox("1 = 印刷" & vbLf & "2 = PDF", , 2) If Not (opType = "1" Or opType = "2") Then MsgBox "キャンセルされました": Exit Sub 'シート設定 Set ipWS = Sheets("入力シート") Set opWS = Sheets("印刷シート") Set lgWS = Sheets("過去発行分") '連番作成 With ipWS If .Range("B2").Value = "" Then MsgBox "データが入力されていません": Exit Sub With .Range("A2", "A" & .Cells(Rows.Count, "B").End(xlUp).Row) .Value = Evaluate("ROW(1:" & .Rows.Count & ")+" & ipWS.Name & "!P1") End With End With 'ループ処理 With opWS For i = 2 To ipWS.Cells(Rows.Count, "A").End(xlUp).Row '書き出しはNoで行い、各項目は計算式を事前に入れておく .Range("Q5").Value = ipWS.Cells(i, "A").Value Select Case opType Case "1" .PrintOut Copies:=1 Case "2" fn = "C:\領収書\" & .Range("I6").Value & "-領収書-" & .Range("P4").Value & ".pdf" .ExportAsFixedFormat xlTypePDF, fn End Select Next i End With '履歴処理 With ipWS If MsgBox("履歴を取り、入力シートをクリアします。印刷・保存が行われたことを確認してからOKを押してください", vbYesNo) = vbYes Then With .Range("J2", .Cells(Rows.Count, "A").End(xlUp)) lgWS.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count).Value = .Value .ClearContents End With End If End With ThisWorkbook.Save End Sub (稲葉) 2019/04/16(火) 14:13
質問の回答ではありませんが、最初に提示されたコードはもう少し整理できそうですのでちょこっとお手伝い。
Sub 連番を入力する_改() Dim i As Long
With Worksheets("入力シート") '▼B2〜B列最終行のセル数を数える i = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp)).Cells.Count
'▼オートフィルで連番を生成 With .Range("A2") .Value = .Parent.Range("P1").Value + 1 .AutoFill Destination:=.Resize(i), Type:=xlFillSeries End With End With
End Sub *************************************************************************** Sub 印刷_改() '// Copies を省略すると 1部 になるため、省略可能 // '// Collate の規定値は True であるため、省略可能 // '// IgnorePrintAreas の規定値は False であるため、省略可能 //
'▼なので、この1行で問題なさげ Sheets("印刷シート").PrintOut End Sub *************************************************************************** Sub PDFで出力_改() Dim wsInvoice As Worksheet ' ←使ってない Dim PdfName As String Dim PdfNo As String Dim strFile As String '保存先フォルダパス&ファイル名(拡張子抜き)
With Worksheets("●●シート") PdfName = .Range("I6").Value PdfNo = .Range("P4").Value strFile = "C:\領収書\" & PdfNo & "-領収書-" & PdfName
'▼3行まとめてこんな感じでも・・ strFile = "C:\領収書\" & .Range("P4").Value & "-領収書-" & .Range("I6").Value End With
Application.DisplayAlerts = False '確認メッセージをオフにする
'▼印刷シートをPDF出力 '( Quality、IncludeDocProperties、IgnorePrintAreas、OpenAfterPublish はいずれも規定値を指定しているから省略) Sheets("印刷シート").ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFile & ".pdf"
'▼用が済んだら戻す Application.DisplayAlerts = True End Sub
なお、基本的に↑のように対象オブジェクト(ブックやシート、セル範囲など)明示すれば、いちいちアクティブにしたり選択したりする必要はありませんので、複数のブックやシートを扱うようになってきたら対象オブジェクトを明示することを意識するとよいかもです。
(もこな2) 2019/04/16(火) 19:34
ありがとうございます。まだまだ初心者なので、これを見て勉強させていただきます!
(キルチ) 2019/04/17(水) 13:07
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.