[[20190416102746]]　『VBAを使った領収書作成』（キルチ）　ページの最後に飛ぶ

『VBAを使った領収書作成』（キルチ）

領収書を自動で印刷するマクロを作っています。
個別操作では色々作れているのですが、ところどころわからないところがあります。

【入力シート】
自動ID　発行日　　　　　宛先　　件名　　　手数料　　事務手数料
6　　　　　2018/4/18　　田中　　机代　　　5000　　　600
7　　　　　2018/4/26　　舟橋　　旅行費　　50000　　1280
というように続きます。（手数料のほかにも項目はあります）
自動IDは前回つくったデータから参照します。

作りたい流れとしては、
◆【入力シート】入力されていればその行に自動ＩＤを振る
◆【入力シート】入力されたデータを１セルごとにコピーし【印刷シート】にある領収書に合うセルにそれぞれ貼り付け（数値を文字列にしないとはみ出した時に＃＃＃となってしまう）
◆【印刷シート】印刷・またはPDFに保存（名前は発行日+領収書+自動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

◆【入力シート】入力されたデータを１セルごとにコピーし【印刷シート】合うセルにそれぞれ貼り付け（数値を文字列にしないとはみ出した時に＃＃＃となってしまう）
不明

◆【印刷シート】印刷・または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]]　『[談]シートレイアウトの投稿どうしてますか？』（ｍｏｍｏ）　
 こちらを使って、それぞれセル番地を教えていただけませんか？
（稲葉） 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("履歴を取り、入力シートをクリアします。印刷・保存が行われたことを確認してからＯＫを押してください", 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

稲葉さん
おかげで無事成功しました。
ちなみに関数のほうは助言通りVLOOKUPでやりました。
項目
=IF(入力シート!E2="","",VLOOKUP($Q$5,入力シート!A:L,5,FALSE))
消費税
=IF(OR(H13="",13>=H13),"",ROUNDDOWN(H13*0.08,0))
（キルチ） 2019/04/16(火) 15:41

書きためている間に稲葉さんからコード提示がありましたが、書いちゃったので投稿しておきます。

質問の回答ではありませんが、最初に提示されたコードはもう少し整理できそうですのでちょこっとお手伝い。

*************************************************************************

    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  であるため、省略可能 //

        '▼なので、この１行で問題なさげ
        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

なお、基本的に↑のように対象オブジェクト（ブックやシート、セル範囲など）明示すれば、いちいちアクティブにしたり選択したりする必要はありませんので、複数のブックやシートを扱うようになってきたら対象オブジェクトを明示することを意識するとよいかもです。

（もこな２） 2019/04/16(火) 19:34

もこな２さん

ありがとうございます。まだまだ初心者なので、これを見て勉強させていただきます！
（キルチ） 2019/04/17(水) 13:07

コメント返信：

[ 一覧(最新更新順) ]

[[20190416102746]] 『VBAを使った領収書作成』（キルチ） ページの最後に飛ぶ

*************************************************************************

[[20190416102746]]　『VBAを使った領収書作成』（キルチ）　ページの最後に飛ぶ