連携 指定シートをPDFファイルにして保存
※より実装に近く表示させる為、コードの改行を避けています。スマホ等で閲覧される際は向きを変えてご覧ください。
※実装するバージョンによってはバージョンアップの仕様により動作しないコードもあります。実装には動作確認の上ご使用下さい。
Sub MakingPDF() '***************************************** '実行コード '***************************************** 'PDFCreator.exeの参照設定が不可の場合は終了 If PDFCreatorFromFile = False Then Exit Sub '作成実行 PrintToPDF_Early End Sub Function PDFCreatorFromFile() As Boolean '***************************************** 'PDFCreator.exe参照設定 '***************************************** Dim objName As String 'PDFCreator.exeの場所 objName = "C:\Program Files\PDFCreator\PDFCreator.exe" If Dir(objName) = "" Then MsgBox "「PDFCreator.exe」が見つかりません！", vbCritical, "参照設定Error!" PDFCreatorFromFile = False Else ThisWorkbook.VBProject.References.AddFromFile (objName) PDFCreatorFromFile = True End If End Function Sub PrintToPDF_Early() '***************************************** '選択中のシートをPDFファイルに変換する '***************************************** '無料オープンソース[PDFCreator] 'http://sourceforge.net/projects/pdfcreator/ '参考ソース 'http://www.excelguru.ca/node/21 'PDFCreator参照設定必要 '試した動作環境：XP HE SP3,EXCEL2000(VB6.0) Dim PDFオブジェクト As PDFCreator.clsPDFCreator Dim PDFファイル名 As String Dim PDF作成パス As String '作成するPDFファイル名指定 PDFファイル名 = "テスト.pdf" '日本語ＯＫ 'そのPDFファイルの保存場所 PDF作成パス = ActiveWorkbook.Path & Application.PathSeparator 'PathSeparator：(\) を返す '※パスを個別に指定する場合、日本語に対応するか不明 '空の値の場合は終了（シート空白） If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub 'IsEmpty：Empty 値の場合に、真 (True) を返す 'UsedRange：指定されたワークシートで使われたセル範囲 (Range オブジェクト) を返す Set PDFオブジェクト = New PDFCreator.clsPDFCreator 'PDFCreatorへの命令 With PDFオブジェクト If .cStart("/NoProcessingAtStartup") = False Then '（※注意） MsgBox "PDFCreatorが初期化されていません！", vbCritical + _ vbOKOnly, "PDFCreator" Exit Sub End If .cOption("UseAutosave") = 1 .cOption("UseAutosaveDirectory") = 1 .cOption("AutosaveDirectory") = PDF作成パス .cOption("AutosaveFilename") = PDFファイル名 .cOption("AutosaveFormat") = 0 ' 0 = PDF .cClearCache End With '（※注意）PDFCreatorが挙動がおかしく動作しない場合は 'タスクマネージャープロセスからPDFCreatorを強制終了させる。 'タスクマネージャー[alt]+[ctrl]+[del] '印刷実行プリンターは「PDFCreator」を選択 ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator" 'オペレーティング システムに制御 Do Until PDFオブジェクト.cCountOfPrintjobs = 1 DoEvents Loop PDFオブジェクト.cPrinterStop = False 'オペレーティング システムに制御 Do Until PDFオブジェクト.cCountOfPrintjobs = 0 DoEvents Loop 'PDFCreator閉じる PDFオブジェクト.cClose 'PDFCreator開放 Set PDFオブジェクト = Nothing End Sub |