[[20121122122044]]　『差し込み印刷のpdf形式保存』（初心者）　ページの最後に飛ぶ

『差し込み印刷のpdf形式保存』（初心者）

 下記のような元々差し込み印刷をするマクロをマクロ記録を利用し、
 pdf保存用に変更しましたが、pdf形式で保存されたファイルには、dataの一番上の
 アイ テムだけしかありませんでした。
 dataシートのA列で1が続き限り、1つのＰＤＦファイルに保存したいのですが、
 下記、コードを修正することで対応可能でしょうか？
 ご教授をお願いします。

 Sub PDF保存()

Dim r As Range

If MsgBox("PDFにして保存しますか？", _
vbQuestion + vbYesNo, "連続保存") <> vbYes Then Exit Sub

With Worksheets("data")

     For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
         If r.Value = 1 Then

            '差込先のセル = 差込元のセル のかたちで指定（※）
            Worksheets("納品書").Range("B2").Value = r.Offset(0, 38).Value
            Worksheets("納品書").Range("B4").Value = r.Offset(0, 9).Value
            Worksheets("納品書").Range("C5").Value = r.Offset(0, 10).Value
            Worksheets("納品書").Range("D5").Value = r.Offset(0, 2).Value
            Worksheets("納品書").Range("F5").Value = r.Offset(0, 5).Value
            Worksheets("納品書").Range("K5").Value = r.Offset(0, 57).Value
            Worksheets("納品書").Range("B6").Value = r.Offset(0, 7).Value
            Worksheets("納品書").Range("G6").Value = r.Offset(0, 50).Value
            Worksheets("納品書").Range("B7").Value = r.Offset(0, 8).Value
            Worksheets("納品書").Range("H8").Value = r.Offset(0, 69).Value
            Worksheets("納品書").Range("B9").Value = r.Offset(0, 12).Value
            Worksheets("納品書").Range("E9").Value = r.Offset(0, 11).Value
            Worksheets("納品書").Range("K3").Value = r.Offset(0, 52).Value

            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\****\Desktop\納品書(1212).pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
         End If
     Next r

End With

End Sub

EXCEL2010
WINDOWS7

 納品書シートが印刷した時に１ページに収まるなら

  Sub PDF保存()
      Dim r As Range
      Dim Dic As Object
      Dim ws As Worksheet
      Dim i As Long
      Dim k As Variant

      If MsgBox("PDFにして保存しますか？", vbQuestion + vbYesNo, "連続保存") <> vbYes Then
          Exit Sub
      End If
      Set Dic = CreateObject("Scripting.Dictionary")
      With Worksheets("data")
          For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
              If r.Value = 1 Then
                  i = i + 1
                  Set ws = Worksheets.Add(Before:=Worksheets(i))
                  Worksheets("納品書").Cells.Copy ws.Range("A1")
                  Dic.Add ws.Name, ""
                  ws.Range("B2").Value = r.Offset(0, 38).Value
                  ws.Range("B4").Value = r.Offset(0, 9).Value
                  ws.Range("C5").Value = r.Offset(0, 10).Value
                  ws.Range("D5").Value = r.Offset(0, 2).Value
                  ws.Range("F5").Value = r.Offset(0, 5).Value
                  ws.Range("K5").Value = r.Offset(0, 57).Value
                  ws.Range("B6").Value = r.Offset(0, 7).Value
                  ws.Range("G6").Value = r.Offset(0, 50).Value
                  ws.Range("B7").Value = r.Offset(0, 8).Value
                  ws.Range("H8").Value = r.Offset(0, 69).Value
                  ws.Range("B9").Value = r.Offset(0, 12).Value
                  ws.Range("E9").Value = r.Offset(0, 11).Value
                  ws.Range("K3").Value = r.Offset(0, 52).Value
              End If
          Next r
      End With
      Set ws = Nothing
      k = Dic.keys
      Worksheets(k).Select
      ThisWorkbook.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\納品書(1212).pdf", _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          From:=1, _
          To:=Dic.Count, _
          OpenAfterPublish:=False
      Set Dic = Nothing
      Application.DisplayAlerts = False
      ActiveWindow.SelectedSheets.Delete
      Application.DisplayAlerts = True

  End Sub

 (暇奴)

暇奴様

上記、ご教授いただき、本当にありがとうございます。
出来上がったＰＤＦを確認したところ、コピー元のエクセルシートは、一枚に収まっているのですが、
コピー先は、1枚に収まらなくなってしまいました。
そのため、部分的に右側が切れたり、下部分が次ページに移ったりしてしまいます。

また、印刷のページ設定の余白が大きいような気がします。

なんとかＰＤＦコピー先へも余白を最大限に、ページ中央も水平、垂直ともに設定し、
1枚に収めたいのですが、どのようにしたら良いか分かりません。
続けて、ご教授いただければ、幸いです。
よろしくお願いいたします。

（初心者）

 Worksheets("納品書").Cells.Copy ws.Range("A1")
 この行以下に納品書のページ設定をwsに設定するコードを追加してみてください。
 (暇奴)

暇奴様
ありがとうございます。
ご教授のとおり、やってみたところ、
一枚に収まりました。
しかし、ＰＤＦとして保存されたファイルを見たら
偶数ページがすべて空白となっていました。

それ以外は、特に問題がありません。

ＰＤＦ編集ソフトで偶数ページを削除しても良いのですが、
できましたら、保存時に調整したく存じます。

お手数ですが、内容を確認いただけたら幸いです。

（初心者）

 １ページに収まるようになっていないだけじゃない？
 もう少し印刷範囲を狭くするとか余白を小さくするとかでどう？
 (暇奴)

上記を参考にしてマクロを作りたいのですが、
一覧にデータがあるものはすべて差し込みしてPDF化したい場合には、
どうすれば良いでしょうか？

（？太郎？） 2015/06/04(木) 11:49

＞If r.Value = 1 Then

 これで、A列に１が入力されている行のみ処理しています。
なので、これがなければ全部PDF化できると思います。

（マナ） 2015/06/04(木) 22:27

＞マナ様　ありがとうございます。

4件目のデータまでPDF化できるようになったのですが、
まだ何か制御がかかっているのでしょうか。

また、印刷範囲外に設定している箇所がPDF化されてしまうのですが、
どのようなコードを追加すれば良いのでしょうか。

アドバイスいただけると幸いです。

- - - - - - - - - - -

      Dim r As Range
      Dim Dic As Object
      Dim ws As Worksheet
      Dim i As Long
      Dim k As Variant

      If MsgBox("PDFにして保存しますか？", vbQuestion + vbYesNo, "連続保存") <> vbYes Then
          Exit Sub
      End If
      Set Dic = CreateObject("Scripting.Dictionary")
      With Worksheets("一覧")
          For Each r In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
                   i = i + 1
                  Set ws = Worksheets.Add(Before:=Worksheets(i))
                  Worksheets("履歴シート").Cells.Copy ws.Range("A1")
                  Dic.Add ws.Name, ""

                  ws.Range("A4").Value = r.Offset(0, 0).Value
                  ws.Range("D4").Value = r.Offset(0, 1).Value

          Next r
      End With
      Set ws = Nothing
      k = Dic.keys
      Worksheets(k).Select
      ThisWorkbook.ExportAsFixedFormat _
          Type:=xlTypePDF, _
          Filename:=ThisWorkbook.Path & "\履歴.pdf", _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          From:=1, _
          To:=Dic.Count, _
          OpenAfterPublish:=False
      Set Dic = Nothing
      Application.DisplayAlerts = False
      ActiveWindow.SelectedSheets.Delete
      Application.DisplayAlerts = True

  End Sub

（？太郎？） 2015/06/05(金) 15:11

 > 4件目のデータまでPDF化できるようになったのですが、
 > まだ何か制御がかかっているのでしょうか。
　
4件目までPDF化できた事について、
期待通りか否かで言えば否であろう事が想像できますが、
どうなれば期待通りなのかが？太郎？さん以外に分からない状況です。
　
どうなれば期待通りなのかを示してください。

 > また、印刷範囲外に設定している箇所がPDF化されてしまうのですが、
 > どのようなコードを追加すれば良いのでしょうか。
　
どんなシートでどんなデータが格納されていて、
印刷範囲とはどの範囲なのか、分かりません。
　
どんな構成なのかを示してください。

 > アドバイスいただけると幸いです。
　
上記が現状出せるアドバイスかと思います。
　
また、元コードでは以下の前提条件が示されています。

 > 納品書シートが印刷した時に１ページに収まるなら
　
この条件は適合しているのでしょうか。
適合して居ないなら
        To:=Dic.Count, _
の辺りが怪しくなります。おそらく。
（ご近所PG） 2015/06/05(金) 15:29

2行変更するとどうなりますか

 Set ws = Worksheets.Add(Before:=Worksheets(i))
 Worksheets("履歴シート").Cells.Copy ws.Range("A1")
　↓
 Worksheets("履歴シート").Copy Before:=Worksheets(i)
 Set ws = ActiveSheet

（マナ） 2015/06/05(金) 20:46

コメント返信：

[ 一覧(最新更新順) ]

[[20121122122044]] 『差し込み印刷のpdf形式保存』（初心者） ページの最後に飛ぶ

[[20121122122044]]　『差し込み印刷のpdf形式保存』（初心者）　ページの最後に飛ぶ