・インストールは、
1.後述するスクリプトのコードを、テキストエディタ等で拡張子を vbs にして保存します。
(ここでは、ファイル名を PdfConverter.vbs と保存した事にして話を進めます)
・使い方は、
1.PDF に変換したいファイルを PdfConverter.vbs のアイコンにドロップします。
(複数のファイルを同時にドロップできますが、フォルダには対応していません)
コード: 全て選択
const Title = "" ' タイトル
const Author = "" ' 作成者
const Subject = "" ' サブタイトル
const Keywords = "" ' キーワード
set args = WScript.Arguments
if args.Count < 1 then WScript.Quit
set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
set oServiceManager = CreateObject("com.sun.star.ServiceManager")
set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")
' 設定値を指定します
dim aLoadProperty(1)
set aLoadProperty(0) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aLoadProperty(0).Name = "ReadOnly"
aLoadProperty(0).Value = true
set aLoadProperty(1) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aLoadProperty(1).Name = "Hidden"
aLoadProperty(1).Value = true
dim aStoreProperty(2)
set aStoreProperty(0) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aStoreProperty(0).Name = "FilterName"
aStoreProperty(0).Value = ""
set aStoreProperty(1) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aStoreProperty(1).Name = "Overwrite"
aStoreProperty(1).Value = true
set aStoreProperty(2) = oServiceManager.Bridge_GetStruct("com.sun.star.beans.PropertyValue")
aStoreProperty(2).Name = "FilterData"
aStoreProperty(2).Value = createPdfFilterData
' ファイル数繰り返します
set oFrame = Nothing
for i = 0 to args.Count - 1
' ファイルを開きます
sLoadName = args.item(i)
sLoadURL = ConvertToUrl(sLoadName)
sStoreName = sLoadName + ".pdf"
sStoreURL = sLoadURL + ".pdf"
set oDoc = Nothing
on error resume next
if oFrame is Nothing then
set oDoc = oDesktop.loadComponentFromURL(sLoadURL, "_blank", 0, aLoadProperty)
set oFrame = oDoc.CurrentController.Frame
else
set oDoc = oFrame.loadComponentFromURL(sLoadURL, "_self", 2, aLoadProperty)
end if
on error goto 0
if not oDoc is Nothing then
' フィルタは指定しなくてもPDFに出力しますが、念の為設定
aStoreProperty(0).Value = getPdfFilter(oDoc)
if not aStoreProperty(0).Value = "" then
nMode = vbYes
if oFileSystemObject.FileExists(sStoreName) then
nMode = Msgbox(sStoreName + chr(13) + "上書きしますか?", vbYesNo)
end if
if nMode = vbYes then
if Title <> "" then oDoc.DocumentInfo.Title = Title
if Author <> "" then oDoc.DocumentInfo.Author = Author
if Subject <> "" then oDoc.DocumentInfo.Subject = Subject
if Keywords <> "" then oDoc.DocumentInfo.Keywords = Keywords
' ファイルをPDFに出力します
call oDoc.storeToURL(sStoreURL, aStoreProperty)
end if
end if
end if
next
' ドキュメントを閉じて終了します
if not oFrame is Nothing then
if oDesktop.Frames.Count > 1 then
call oFrame.close(true)
else
call oDesktop.terminate
end if
end if
msgbox "終了しました", vbOkOnly, "PDF Converter"
WScript.Quit
function createPdfFilterData
const DIRECT_VALUE = 0
createPdfFilterData = Array( _
Array("UseLosslessCompression",0,true,DIRECT_VALUE), _
Array("Quality",0,90,DIRECT_VALUE), _
Array("ReduceImageResolution",0,false,DIRECT_VALUE), _
Array("MaxImageResolution",0,300,DIRECT_VALUE), _
Array("UseTaggedPDF",0,true,DIRECT_VALUE), _
Array("SelectPdfVersion",0,0,DIRECT_VALUE), _
Array("ExportNotes",0,false,DIRECT_VALUE), _
Array("ExportBookmarks",0,true,DIRECT_VALUE), _
Array("OpenBookmarkLevels",0,-1,DIRECT_VALUE), _
Array("UseTransitionEffects",0,true,DIRECT_VALUE), _
Array("IsSkipEmptyPages",0,true,DIRECT_VALUE), _
Array("IsAddStream",0,false,DIRECT_VALUE), _
Array("EmbedStandardFonts",0,false,DIRECT_VALUE), _
Array("FormsType",0,0,DIRECT_VALUE), _
Array("ExportFormFields",0,true,DIRECT_VALUE), _
Array("AllowDuplicateFieldNames",0,false,DIRECT_VALUE), _
Array("HideViewerToolbar",0,false,DIRECT_VALUE), _
Array("HideViewerMenubar",0,false,DIRECT_VALUE), _
Array("HideViewerWindowControls",0,false,DIRECT_VALUE), _
Array("ResizeWindowToInitialPage",0,false,DIRECT_VALUE), _
Array("CenterWindow",0,false,DIRECT_VALUE), _
Array("OpenInFullScreenMode",0,false,DIRECT_VALUE), _
Array("DisplayPDFDocumentTitle",0,true,DIRECT_VALUE), _
Array("InitialView",0,0,DIRECT_VALUE), _
Array("Magnification",0,0,DIRECT_VALUE), _
Array("Zoom",0,100,DIRECT_VALUE), _
Array("PageLayout",0,0,DIRECT_VALUE), _
Array("FirstPageOnLeft",0,false,DIRECT_VALUE), _
Array("InitialPage",0,1,DIRECT_VALUE), _
Array("Printing",0,2,DIRECT_VALUE), _
Array("Changes",0,4,DIRECT_VALUE), _
Array("EnableCopyingOfContent",0,true,DIRECT_VALUE), _
Array("EnableTextAccessForAccessibilityTools",0,true,DIRECT_VALUE), _
Array("ExportLinksRelativeFsys",0,false,DIRECT_VALUE), _
Array("PDFViewSelection",0,0,DIRECT_VALUE), _
Array("ConvertOOoTargetToPDFTarget",0,true,DIRECT_VALUE), _
Array("ExportBookmarksToPDFDestination",0,false,DIRECT_VALUE), _
Array("_OkButtonString",0,"",DIRECT_VALUE), _
Array("EncryptFile",0,false,DIRECT_VALUE), _
Array("DocumentOpenPassword",0,"",DIRECT_VALUE), _
Array("RestrictPermissions",0,false,DIRECT_VALUE), _
Array("PermissionPassword",0,"",DIRECT_VALUE), _
Array("",0,,DIRECT_VALUE))
end function
function getPdfFilter(oDoc)
aFilterName = ""
if oDoc.supportsService("com.sun.star.text.TextDocument") then
aFilterName = "writer_pdf_Export"
end if
if oDoc.supportsService("com.sun.star.text.WebDocument") then
aFilterName = "writer_web_pdf_Export"
end if
if oDoc.supportsService("com.sun.star.text.GlobalDocument") then
aFilterName = "writer_globaldocument_pdf_Export"
end if
if oDoc.supportsService("com.sun.star.sheet.SpreadsheetDocument") then
aFilterName = "calc_pdf_Export"
end if
if oDoc.supportsService("com.sun.star.drawing.DrawingDocument") then
aFilterName = "draw_pdf_Export"
end if
if oDoc.supportsService("com.sun.star.presentation.PresentationDocument") then
aFilterName = "impress_pdf_Export"
end if
if oDoc.supportsService("com.sun.star.formula.FormulaProperties") then
aFilterName = "math_pdf_Export"
end if
getPdfFilter = aFilterName
end function
function ConvertToUrl(ByVal sFileName)
sFileName = Replace(sFileName, "\", "/")
sFileName = Replace(sFileName, "%", "%25")
sFileName = Replace(sFileName, " ", "%20")
sFileName = Replace(sFileName, "#", "%23")
sFileName = Replace(sFileName, "&", "%26")
sFileName = Replace(sFileName, "+", "%2B")
sFileName = Replace(sFileName, "<", "%3C")
sFileName = Replace(sFileName, "=", "%3D")
sFileName = Replace(sFileName, ">", "%3E")
sFileName = Replace(sFileName, "@", "%40")
sFileName = "file:///" + sFileName
ConvertToUrl = sFileName
end function