違うシートのデータを1つのPDFファイル保存する方法を教えてください
- エクセル2007以降のバージョンを使用している場合、コマンドボタンを押すとシート名「A」と隣にあるシート名「B」をまとめてPDFファイルで保存することができます。
- 保存されるPDFファイルの第1ページはシート名「A」の内容が表示され、第2ページはシート名「B」の内容が表示されます。
- PDF化する際には、シート名「A」のL2セルに入力された日付をファイル名として使用します。
- ベストアンサー
違うシートのデータを１つのPDFファイル保存VBA
Sub データPDFファイル化() If MsgBox("ファイルをPDF化し過去データとして保存します。よろしいでしょうか？", vbYesNo) = vbNo Then End End If If Range("L2").Value <> "" Then Dim Fn As String Fn = Format(Range("L2"), "yyyy年m月d日") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:="D:\フォルダB\過去記録データ保存用フォルダ\データ\" & Fn Else MsgBox "セルL2にファイル名が入力されていません。", vbExclamation End If End Sub この様なコードがあります。エクセル２００３では使用出来ないのでエクセル２００７以降の使用です。 これはシート名「A」にコマンドボタンを設置し、そのコマンドボタンを押すとPDF化して保存するマクロです。 そこで質問ですがコマンドボタンを押すとシート名「A」と隣にあるシート名「B」をまとめてPDFファイルで保存する方法はどの様にすれば良いのでしょうか？ PDF化した際は１ページ目がシート名「A」で２ページ目がシート名「B」を表示させ、名前はシート名「A」のL2（yyyy年m月d日）で保存します。
- Excel（エクセル）
- 回答数1
- ありがとう数22
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
PDF化するコードの前にシートを複数選択する部分を追加すればいいかと思います。 Sheets(Array("A", "B")).Select ’★追加 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:="D:\フォルダB\過去記録データ保存用フォルダ\データ\" & Fn
関連するQ&A
- シートだけを保存したいのですが？
はじめましてマクロ初心者です。 検索しましたがわからなかったので、質問させていただきます。 保存をキャンセルすると新規ブックができてしまいます。 キャンセルした時に新規ブックを作りたくないのですが、教えてください。 Sub シート保存() Dim Answer3 Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant Answer3 = MsgBox("本当に保存しますか？", vbYesNo) If Answer3 = vbYes Then Sheets("保存シート").Select Application.CutCopyMode = False Sheets("保存シート").Copy Else MsgBox ("キャンセルしました。") End If 既定ファイル名 = Range("V8") 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名) If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else ActiveWorkbook.SaveCopyAs 保存ファイル名 End If End Sub よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでPDF保存ができません
エクセルのシートを連続してPDFで出力するVBAで困っています。 自分の端末内で動かす分にはぜんぜん問題はありません。ところが会社のサーバー内の共有フォルダーに保存して動かすと、最初の1件だけは正常にPDFに保存されますが、何度やっても２件目でエラーになりPDFが保存されません。 「実行時エラー1004 ドキュメントを保存できませんでした。ドキュメントが開いているか、保存時にエラーが発生した可能性があります。」 となってしまうのです。 PDFが保存されないうちに次のPDFを作成して保存しているためかと思いApplication.Waitで10秒待つようにしたところ最後まで保存ができました。 しかし、自分の端末内ではWaitを入れなくとも問題なくできます。 質問は、この原因と、一律にApplication.Waitで10秒待たなくとも別の方法で対応する方法はないかということです。 よろしくお願いいたします。 Sub TEST01() '2020/10/10 Dim Fdr As String, Fn As String Dim n As Long With Sheets("Test") .Activate Fdr = ThisWorkbook.Path & "\" & Format(Date, "YYYYMMDD") & "-PDF" 'PDF保存先' If Dir(Fdr, vbDirectory) = "" Then MkDir Fdr '無ければ作成 End If For n = 1 To 20 .Range("C5").Value = Sheets("Data").Cells(n, "A").Value Fn = .Range("C5").Value & "_" & .Range("D5").Value 'ファイル名 Application.StatusBar = Fn & " PDFファイル作成中/" & n & "件目" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fdr & "\" & Fn & ".pdf" Application.Wait Now() + TimeValue("00:00:10") '10秒PDF保存完了を待つ（1-8秒では保存エラー） Next n End With Application.StatusBar = "" End Sub
- ベストアンサー
- Excel（エクセル）
- エクセル シートのみ 保存
過去の質問も参照しましたが 当てはまる物が無くて質問しました！ シート上にボタンを作成して クリックするとそのシートのみ 指定するファイルにコピーさせたいです！ 下記の部分で何処を変化させればよいのでしょうか？ (1)～(2)の部分で困っています。 Private Sub CommandButton1_Click() Dim FileName As String Dim FileExt As String ’(1)の質問！○＝の部分をSheets（セルのA1の値をファイル名に入れたいです） FileName = "○"& Format(Now, "yyyy-mm") & ".XLS" '==== FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If '==== FileName = "D:\保存\ケア\計画\" & FileName If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 上書きしますか?", vbOKCancel, "上書きの確認") = vbCancel Then '##保存せずに終了 Exit Sub ElseIf ThisSheets.FullName = FileName Then '##現在開いているファイルと同じなら上書き保存 ThisSheets.Save Else '##指定ファイルを削除した後保存 Kill FileName ThisSheets.SaveCopyAs FileName:=FileName End If Else '##ファイルを新規保存 ThisSheets.SaveCopyAs FileName:=FileName End If ThisSheets.Saved = True End Sub (2)ThisSheets＆指定してもう一つだけ 保存先にコピーしたいです！つまり ２つのSheetのみ保存させたいのですが・・ ここからどのようにしたら良いのか お願いします！教えて下さい。
- ベストアンサー
- オフィス系ソフト
- （VBA）特定のシートのみを名前を付けて保存
Excel2003です。 数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。 この非表示の状態で保存するにはどのようにすればよいのでしょうか？ 【以下現在のコードです】 ------------------------------------------------ Sub 名前を付けて保存() '報告書を"名前を付けて保存" Sheets("報告書").Select Dim 既定ファイル名 As String Dim 保存ファイル名 As Variant 既定ファイル名 = "報告書" 保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls") If 保存ファイル名 = False Then MsgBox "保存は中止されました。" Else With ThisWorkbook.ActiveSheet Workbooks.Add .Cells.Copy ActiveSheet.Range("A1") ActiveWorkbook.SaveAs 保存ファイル名, xlNormal ActiveWorkbook.Close False End With Sheets("報告書").Select Range("A1").Select MsgBox "報告書を作成しました。" End If End Sub ----------------------------------------------------
- ベストアンサー
- オフィス系ソフト
- エクセル VBA シート保存ボタン
Sheet上にボタンを作成 ボタンを押すと保存するようにしています！ 以前ここでSheet2枚をコピー出来るような 記述教えてもらったのですが・・ 1枚ならどう変化して良いか・・ 記述を書きましたが 何処が違うか教えて下さい！ Private Sub CommandButton1_Click() Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "ko" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("A1").Value FileName = BkName & Format(Now, "yyyy-mm") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1)).Copy Set NewWkbook = ActiveWorkbook For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count NewWkbook.Sheets(1).Shapes(wIx).Delete Next NewWkbook.Sheets(1).Name = StName1 ' FileName = "D:\保存\計画\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub 教えて下さい！
- ベストアンサー
- オフィス系ソフト
- Excel2007VBAを使ってPDF保存するには
宜しくお願い致します。 あるサイトを参考に自分の設定を下記情報に設定しました。 保存の画面が出るのですが、【OK】しても実際にはデスクトップには保存されません。 ちゃんとデスクトップに保存をするにはどうしたら良いでしょうか？ VBAの知識はなく、さっぱりわかりません。 どうぞご教授をお願い致します。 Sub SaveFileSample011() Dim SaveFileName Dim wScriptHost As Object, strInitDir As String 'カレントディレクトリをデスクトップに変更 a = Range("a2").Value b = Range("c9").Value Set wScriptHost = CreateObject("WScript.Shell") ChDir wScriptHost.SpecialFolders("Desktop") SaveFileName = Application.GetSaveAsFilename(a & "様" & b, "PDFとして保存,*.pdf") If SaveFileName <> False Then MsgBox "入力されたファイル名は、" & SaveFileName & " です。", vbInformation Else MsgBox "キャンセルがクリックされました。", vbInformation End If End Sub
- ベストアンサー
- その他MS Office製品
- エクセルの同一シートをPDFで保存するVBA
下記のページでサンプルをダウンロードしました。 http://pc.nikkeibp.co.jp/article/NPC/20070301/263710/ 1つのシートを連続印刷するものです。 しかしながら、これをPDFに出力する場合、1データ毎に 保存場所を確認してきます。しかも、保存ファイル名も同一です。 （通常使うプリンタをPDF Printerに指定） これを自動で、1つのPDFファイルに全データを保存、 もしくは、1つのpdfに1つのデータが保存されたものを人数分、 保存することは可能でしょうか？ Sub 個人票印刷() Range("個人番号") = Range("自") Do While Range("個人番号") <= Range("至") Sheets("個人票").PrintOut Range("個人番号") = Range("個人番号") + 1 Loop End Sub
- 締切済み
- オフィス系ソフト
- エクセルシートをVBAでPDFファイルで保存する
いつもお世話になっております。 先日ここで、(1)エクセルシートから自動でPDFファイルを作成し、(2)所定のフォルダに自動で保存し、(3)作成されたPDFファイルを決まった宛先に自動送信する、というVBAのコードを教わって非常に満足して使い始めたのですが、使ってみたらどんどん欲が出てきて３度目の質問です。 上記のコードでは、PDFファイルが「送信.pdf」で上書きされてしまう事は分かっていたのですが、メールの送信日時で区別できるので送信BOXから手動で専用BOXに移動すれば良いと思ったのですが、やはりPDFファイルを所定のフォルダーに自動で保存できれば一気に完了するので何とかならないかと。 一応NETで「日付をファイル名にする」といういくつかのコードを調べて種々試行錯誤してみたのですが、当方の実力では下記のVBAコードに組み込むことはできないとの結論に至りました。（情けない限り） 追加したいことは自動作成されるpdfファイルを上書きされずに所定のフォルダに自動保存する、です。 ファイル名としては特定のセルの値（これがbest)、もしくは日付（yyyy/dd/mm）でも十分です。 とにかく自動作成されるPDFファイルが所定のフォルダに上書きされずに保存されればOKなのですが。 本当に何度も追加質問をすることになってしまって申し訳ないのですが宜しくお願いいたします。 Sub Test() Dim FilePath As String, strSub As String Dim OutlookApp As Object Dim OutlookMail As Object 'On Error Resume Next FilePath = "\\ABC\123\あいう\アイウ\サンプル名\結果報告書\送信.pdf" 'Sheet3の結果報告書の特定のセルに品名 strSub = Worksheets("結果報告書").Range("E14").Value & "XXXX" & "LOT " & Range("E19") Worksheets("結果報告書").ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) With OutlookMail .To = "*****@xxxxx.co.jp" .CC = "" .BCC = "" .Subject = strSub .Body = "表題の件添付の通りです。" .Attachments.Add FilePath .Send End With MsgBox "送信完了" End Sub
- ベストアンサー
- Excel（エクセル）
- VBA 保存
保存ボタンを作成してファイルに飛ぶように させていますが…どうしてもエラーになります！ エラー表示内容＞ 実行時エラー１００４ シートの名前を他のシート、Visual Basicで参照される オブジェクト ライブラリまたは ワークシートと同じ名前に変更することはできません。 下記は実際の記述です。 Private Sub 保存_Click() Dim FileName As String Dim FileExt As String Dim BkName As String Dim OldWkbook As Workbook Dim NewWkbook As Workbook Const StName1 As String = "計画 グラフ" Const StName2 As String = "ケア一覧" ' Application.DisplayAlerts = False Set OldWkbook = ActiveWorkbook ' 'ファイル名を取得 BkName = OldWkbook.Sheets(StName1).Range("D1").Value FileName = BkName & Format(Now, "yyyy-mm-dd") & ".XLS" ' FileName = InputBox(FileName & "と言う名前で保存します" & vbCr & "よろしければこのままOKをクリックしてください", "保存ファイル名の確認", FileName) If FileName = "" Then Exit Sub Else If Right(FileName, 4) <> ".XLS" Then MsgBox "ファイル名が異常です。" Exit Sub End If End If ' OldWkbook.Sheets(Array(StName1, StName2)).Copy Set NewWkbook = ActiveWorkbook For wIx = 1 To NewWkbook.Sheets(1).Shapes.Count NewWkbook.Sheets(1).Shapes(1).Delete '←シート1のボタンを削除 Next NewWkbook.Sheets(1).Name = StName1 NewWkbook.Sheets(2).Name = StName2 ' FileName = "D:\看護計画保存\" & FileName ' If Dir(FileName) <> "" Then '##ファイルが既に存在する If MsgBox("既に指定のファイルが存在します。 置き換えますか?", vbOKCancel, "置き換えの確認") = vbCancel Then NewWkbook.Close savechanges:=False '##保存せずに終了 Exit Sub End If '##指定ファイル置き換え保存 NewWkbook.SaveAs FileName:=FileName Else '##ファイルを新規保存 NewWkbook.SaveAs FileName:=FileName End If ' NewWkbook.Close savechanges:=False Application.DisplayAlerts = True End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルにて、VBAで名前を付けて保存する場合
こんにちは、色々試しているのですが、うまくいかずに悩んでいます。 コマンドを実行すると、名前を付けて保存のダイアログ画面を表示させるＶＢＡを作りたいです。 ただし、 (1)保存せずに、ダイアログを表示させる状態で停止させる。 (2)ダイアログ表示時、ファイル名欄に”売上集計表yyyy年mm月”というファイル名が入っている。（yyyyとmmは変数。コマンド実行時に入力する事でファイル名もそれに対応する。） 以下の様にVBAを組んだのですが（他にも色々組んでいますが、うまく動いている個所は省いてます。）、上記(1)(2)共に思い通りに動いてくれません。分かるかたがいましたら、よろしくお願いします。 Sub 保存() ' ' Macro1 Macro Dim rtn Dim myD As String, msg As String, fn As String, x As String Dim wb As Workbook, ws As Worksheet line: ' 年月の入力処理 rtn = Application.InputBox("入力する月を西暦YYYYMM形式で入力してください。" _ & vbNewLine & "例）2011年7月⇒201107", Type:=1) If rtn = False Then Exit Sub myD = Left(rtn, 4) & "/" & Right(rtn, 2) & "/01" If Not IsDate(myD) Then MsgBox "存在しない年月です！", vbCritical GoTo line Else If MsgBox(Format(myD, "yyyy年mm月") & "で間違いないですか？", vbYesNo + vbQuestion) = vbNo Then Exit Sub End If End If 'ファイルの保存 ChDir "C:\Users\（ユーザー名）\Desktop\新しいフォルダー" ActiveWorkbook.SaveAs Filename:= _ "C:\Users\（ユーザー名）\Desktop\新しいフォルダー\売上集計表保存" & "Year(myD)" & "年" & "Month(myD)" & "月" & ".xlsm", FileFormat:= _ xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False End Sub
- ベストアンサー
- オフィス系ソフト
お礼
上記回答をヒントにＶＢＡを組む事が出来ました。 この度はありがとうございました。