EXCEL(2010)から標準のPDF保存ではサイズが大きくなり、メール添付に適さないための対策
(1)CubePDFを使用する http://www.cube-soft.jp/cubepdf/
(2)各シートの解像度が変わる場合(全列・全行を1ページに収める場合など)は、CubePDFで1シートづつ印刷して、CubePDF側のダイアログの設定で書き出したPDFに追記する
(Excel は複数シートを選択して印刷をかけた時、ページ毎の設定が異なっている場合に「1 ページ毎に印刷コマンドを実行する」と言う挙動を示す事があるため)
-----株式会社キューブ・ソフトのサポートからのご教示による
http://support.microsoft.com/kb/816935/ja
http://okwave.jp/qa/q6118128.html
以上の条件に沿ったVBAのソースコードは下記
Dim n As Integer
Dim print_name As String
Dim ws As Worksheet
Dim cuHw As Long
Dim cuHw2 As Long
Dim シート名 As Variant
print_name = Application.ActivePrinter '現在使用しているプリンター名を取得しておく
n = 0
For Each シート名 In シート名配列
ThisWorkbook.Sheets(シート名).PrintOut ActivePrinter:="CubePDF"
'個々のシートをCubePDFで印刷
Sleep 5000 '印刷起動後5秒停止(原始的だが時間指定で待機)
cuHw = 0
Do '「CubePDF 1.0.0RC8 (x86)」のダイアログのハンドルを取得するまでループ
cuHw = FindWindow(vbNullString, "CubePDF 1.0.0RC8 (x86)") 'タイトルで指定
Loop While cuHw = 0
BringWindowToTop cuHw
'「CubePDF 1.0.0RC8 (x86)」のウィンドウをアクティブに(Windows7)
Sleep 1000 '1秒停止
'「CubePDF 1.0.0RC8 (x86)」のダイアログのファイル名パスに書き込み
'(起動後に表示されるダイアログにパラメタを入力するテクニック)
'感謝→ http://okwave.jp/qa/q8318460.html
With CreateObject("Wscript.Shell")
.SendKeys "{TAB}"
.SendKeys "{TAB}".SendKeys "{TAB}"
.SendKeys "{TAB}"
.SendKeys "{TAB}"
.Run "%COMSPEC% /c echo " & 生成PDFファイルパス & "| clip", 0, True
'クリップボードに生成PDFファイルパスをコピー
.SendKeys "^v" '貼り付け
.SendKeys "{ENTER}"
End With
If (n > 0) Then
'2シート目以降は「CubePDF 確認」ダイアログのハンドルを取得するまでループ
'(CubePDF側で「末尾に結合」の設定になっていることが必須)
cuHw2 = 0
Do
cuHw2 = FindWindow(vbNullString, "CubePDF 確認") 'タイトルで指定
Loop While cuHw2 = 0
BringWindowToTop cuHw2 'ウィンドウをアクティブに(Windows7)
Sleep 1000 '1秒停止
With CreateObject("Wscript.Shell")
.SendKeys "{ENTER}" '「CubePDF 確認」のダイアログのボタンを押す
End With
End If
n = n + 1
Next
Application.ActivePrinter = print_name 'プリンター名を元に戻す
CubePDF書き出しsub = 生成PDFファイルパス
End Function
0 件のコメント:
コメントを投稿