【ExcelVBA】値を変更しながら連続でPDFを作成し，ファイル名を自動で付して出力するコード

Question

「回答」シートにおいて１行に１件ずつデータが入っており，I２セルからI3セルで行番号を始点，終点として指定すると「様式」シートに指定した行のデータが順番に反映され，それらを結合した状態で出力し，ファイル名はI2セルに入力した行のデータ容に則したものになるコードについて伺います。

以前，この掲示板で質問させていただいおり，そのときは「ファイル名はI2セルに入力した値のときに「様式」シートに反映される内容に則したものにしたい」という条件がなかったため，そのときに教えていただいたコードに修正を加えたものが以下のコードですがエラーで止まってしまいます。
（l = Sheets("回答").Range("N7").Value &～の部分で止まってしまいます）

どのように修正したらよいか，ご教示願います。


Sub 連続PDF作成()
Dim stK, stY, stD
Dim startN, endN, i As Long
Const AA = "A1:H40" ' ← コピー(転記)対象のセル範囲
Dim l As String ' ← 作成するPDFファイル名

Set stK = Worksheets("回答")
Set stY = Worksheets("様式")
startN = stK.Range("I2").Value
endN = stK.Range("I3").Value
If Application.CountBlank(stK.Range("I2:I3")) > 0 Or _
Not (IsNumeric(startN) And IsNumeric(endN)) Then _
MsgBox "無効な入力です": Exit Sub


Application.ScreenUpdating = False
Application.DisplayAlerts = False
stY.Copy
With ActiveWorkbook
Set stD = ActiveSheet
For i = startN To endN
stK.Range("A5").Value = stK.Cells(i + 9, 1).Value
stD.Copy after:=.Worksheets(.Worksheets.Count)
.Worksheets(.Worksheets.Count).Range(AA).Value = stY.Range(AA).Value
Next i

stD.Delete

stK.Range("A7").Value = stK.Cells(startN + 9, 1).Value
l = Sheets("回答").Range("N7").Value & "・" & Sheets("回答").Range("G7").Value & "・" & Sheets("回答").Range("D7").Value

.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & l & ".pdf"
.Close False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Qchan1962 · Accepted Answer

こんばんは
上から読んだだけで試していませんが
勘違いをしているようですね
よくRange()などでやるやつですね
オブジェクトを明示しないため間違った場所を探す不具合　今回はWorkbook

stY.Copy　で　新しいブックが作られます（1シートのみ）
これがActiveWorkbookです
Sheets("回答")のブックは？ThisWorkbookのはずです
しかし　l = Sheets("回答")（エラー対象コード）が走る時
まだ新規ブックがアクティブになっているので当然 Sheets("回答")はありませんね

対策は＃３様のアドバイスを支持しますが

改造して不具合と言う事で付け加えます

通常　処理は上から下に流れていきます
大まかに　入力（条件定義・設定・値の取得など）メイン処理　出力

今回加えたのはエラー部分と見受けられますが
l = Sheets("回答").Range("N7").Value ・・・・

変数 l はメイン処理の結果を必要としていない様ですの
上流で変数 l に値を代入すればスムースな気がします

MsgBox "無効な入力です": Exit Sub　の下あたり
もっとも　Sheets("回答")は　せっかく変数を作っているのですから
stK.Range("N7").Valu・・・・
上手く言えませんが　Withの中で他のオブジェクトを明示しないで使うのは避けた方が良いと思います（あらかじめ変数などにセットし明示する）

Qchan1962 · Answer

連投になってしまい申し訳ありません
やっちゃいました。。。確認せずにすぐ投稿してしまう癖
出力PDFファイル名は変更箇所が含まれないので　＃５が間違えです;

エラーとは関係ないところですが
よく見るとおかしいですね
＞それらを結合した状態で出力し　
各ページの内容を変えながら１pdfファイルにまとめて（複数ページで）出力したい？
現状ブックシートを増やしているので
１pdfファイルにまとめて（複数ページで）出力は出来ないと思います

やるとしたら初めの1シートは現状のCopyで新規ブックを作り
内容を変更した元シートを新規ブックのインデックス１（Copyで出来た）シートの下部または右にペーストしてつなげて行き同じシートにまとめてページ設定して出力します（ブックを作ってからやるのかもしれないけれど）

ページごとに別ファイルを出力するなら　都度名前を変更する必要があるのと　出力部分をループ内に入れる事で出来ると思います

＞「ファイル名はI2セルに入力した値のときに「様式」シートに反映される内容に則したものにしたい」
l = Sheets("回答").Ran・・・　説明とシート名が一致していない
＞stY.Range(AA).Value　変更コードが無い

最終stK.Range("A5").Valueは　stK.Cells(endN + 9, 1).Value
ループ内に入れる理由？
stY.Range(AA)が
stK.Range("A5").Valueを参照している関数？かもしれないが・・

とりあえず
l = Sheets("回答").Range("N7").Value & "・" & Sheets("回答").Range("G7").Value & "・" & Sheets("回答").Range("D7").Value
.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & l & ".pdf"
.Close False
を消して目的のブックが出来ているか確認する必要がありそうかな

惑わせる回答ついでに　
目的のブックが出来る事が前提ですが添削してみました

各ページの内容を変えながら１pdfファイルにまとめて（複数ページで）出力付け足す考え方で

Sub 連続PDF作成2()
      Dim stK, stY, stD
      Dim startN, endN, i As Long
      Const AA = "A1:H40" ' ← コピー(転記)対象のセル範囲
      Dim l As String ' ← 作成するPDFファイル名
      
      Set stK = Worksheets("回答")
      Set stY = Worksheets("様式")
      startN = stK.Range("I2").Value
      endN = stK.Range("I3").Value
      If Application.CountBlank(stK.Range("I2:I3")) > 0 Or _
   Not (IsNumeric(startN) And IsNumeric(endN)) Then _
   MsgBox "無効な入力です": Exit Sub
      
      l = stK.Range("N7").Value & "・" & stK.Range("G7").Value & "・" & stK.Range("D7").Value
      
      Application.ScreenUpdating = False
      Application.DisplayAlerts = False
      stY.Copy
      With ActiveWorkbook
            Set stD = ActiveSheet
            For i = startN To endN
                  stK.Range("A5").Value = stK.Cells(i + 9, 1).Value
                  stD.Copy after:=.Worksheets(.Worksheets.Count)
                  .Worksheets(.Worksheets.Count).Range(AA).Value = stY.Range(AA).Value
            Next i
            
            Dim n As Long, rCount As Long
            If endN - startN > 0 Then
                  With .Worksheets(2).UsedRange
                        rCount = .Rows(.Rows.Count).Row
                  End With
                  For i = 3 To .Worksheets.Count
                        With .Worksheets(2).UsedRange
                              n = .Rows(.Rows.Count).Row + 1
                        End With
                        .Worksheets(i).UsedRange.Copy .Worksheets(2).Cells(n, 1)
                  Next i
                  
                  .Worksheets(2).PageSetup.PrintArea = .Worksheets(2).UsedRange.Address
                  For i = rCount + 1 To n Step rCount
                        .Worksheets(2).Rows(i).PageBreak = xlPageBreakManual
                  Next
                  
            End If
            
            .Worksheets(2).ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\" & l & ".pdf"
            .Close False
      End With
      
      stK.Range("A7").Value = stK.Cells(startN + 9, 1).Value
      
      Application.DisplayAlerts = True
      Application.ScreenUpdating = True
End Sub

始めのページ　stD.Delete　でいらないようなので
シートインデックス2にまとめています
いる場合はシートインデックス　２　を　１に　シートインデックスループ初期値　３　を　2　にすると初めのコピペシートが含まれるようになります
新規ブックはどのみち保存せずに閉じるので　削除などは不要ですね

Qchan1962 · Answer

酔って寝る前に回答してはダメですね
＞stK.Range("A5").Value = stK.Cells(i + 9, 1).Value

前言撤回します
変数 l はメイン処理の結果を必要としていない様ですの上流で変数 l に値を代入すればスムースな気がします

すみませんでした

hnks192059 · Answer

エラーの行について
 「Sheets("回答")」の記述を「stK」
に変更するとどうですか？

fujillin · Answer

こんばんは

＞l = Sheets("回答").Range("N7").Value &～の部分で止まってしまいます
通常であれば、このセンテンスでエラーになることは無いと思いますが・・

妄想を逞しくしてみるなら・・・
（以下は妄想なので、当たるも八卦です）
エラーメッセージは「インデックスが～～」だったりしませんか？

もしそうなら、
＞Set stD = ActiveSheet
のActiveSheetは「回答」シートだったりしませんか？
（ご提示のコードのこの部分が何をしたいのか不明ですが・・）
更に、もしそれも当たっているなら、
＞stD.Delete
でシートを削除しているので、「参照先が見つからない」というエラーですね。

作成中やデバッグ中は、
＞Application.ScreenUpdating = False
＞Application.DisplayAlerts = False
などは、外しておいた方が、原因等も見つけやすいと思いますよ。

hnks192059 · Answer

エラーで止まってしまうとのことですが
どのようなエラーですか？

Err.Number
や
Err.Description
の内容をここに書いていただくと答えていただく人がでてくるかもしれません

【ExcelVBA】値を変更しながら連続でPDFを作成し，ファイル名を自動で付して出力するコード

こんばんは

連投になってしまい申し訳ありません

酔って寝る前に回答してはダメですね

エラーの行について

こんばんは

エラーで止まってしまうとのことですが

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング