VBScriptでcom.sun.star.beans.PropertyValueの作成方法

例として

  Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
  Set oCoreReflection = oServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
  Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")

  Dim classSize
  Set classSize = oCoreReflection.forName("com.sun.star.beans.PropertyValue")

  Dim oDoc

  Dim args1(0)
  classSize.createObject args1(0)
  args1(0).Name = "Hidden"
  args1(0).Value = false

  On Error Resume Next
  Set oDoc = oDesktop.loadComponentFromURL(sURL, "_default", 0, args1)

詳細はsoplayer.vbs - StarOffice Presentation Playerへ

'
' soplayer.vbs - StarOffice Presentation Player
'
' Version 0.3 written in VBScript             - December 13, 2007  by Takamichi Akiyama  
' Version 0.2 written in OpenOffice.org BASIC - December 13, 2007  by Takamichi Akiyama  
' Version 0.1 - July 30, 2004 by Takamichi Akiyama  
' License: GNU LGPL
'
' この VBScript は、プレゼンテーションのファイルを開いて、プレゼンテーションを開始します。
' プレゼンテーションが終了すると、自動的にファイルを閉じます。

' 使い方その１
' このファイルのアイコンへ、プレゼンテーションのファイルをドラッグアンドドロップします。
'
' 使い方その２
' このファイルを実行すると、ファイルを開くダイアログが表示されますので、プレゼンテーションのファイルを選択します。
'
' どちらの方法でも、１つ以上のファイルを指定できます。その場合は、順番にプレゼンテーションが表示されます。
'

Public oServiceManager, oCoreReflection, oDesktop
Set oServiceManager = CreateObject("com.sun.star.ServiceManager")
Set oCoreReflection = oServiceManager.createInstance("com.sun.star.reflection.CoreReflection")
Set oDesktop = oServiceManager.createInstance("com.sun.star.frame.Desktop")

Call Main

Sub Main
 Dim oArgs, sPath, sURL, sURLs, sPDF, I
 Set oArgs = WScript.Arguments
 If oArgs.Count > 0 Then
  ' Drag and Drop Interface
  For I = 0 to oArgs.Count - 1
   sPath = oArgs(I)
   sURL = convertToURL(sPath)
   play sURL
  Next
 Else
  ' File Selection Dialog Interface
  sURLs = getURLs_for_Open()
  For I = 0 To UBound(sURLs)
   sURL = sURLs(I)
   play sURL
  Next
 End If
End Sub

Function convertToURL(sPath)
 Dim regEx, sURL
 Set regEx = New RegExp
 regEx.IgnoreCase = True
 regEx.Global = True
 regEx.Pattern = "\\"
 sURL = "file:///" + regEx.Replace(sPath, "/")
 convertToURL = sURL
End Function

Function getURLs_for_Open()
 Dim oFilePicker, sFiles
 Set oFilePicker = oServiceManager.createInstance("com.sun.star.ui.dialogs.FilePicker")
 Dim args(0)
 args(0) = 0 'com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
 With oFilePicker
  .initialize(args)
  .setTitle "プレゼンテーションのファイルを選んでください。ShiftやCtrlキーを押しながら、複数のファイルを一度に選択できます。"
  .AppendFilter "プレゼンテーションのファイル (*.odp;*.sxi;*.ppt)", "*.odp;*.sxi;*.ppt"
  .SetCurrentFilter "プレゼンテーションのファイル (*.odp;*.sxi;*.ppt)"
  .setMultiSelectionMode(True)
 End With
 If oFilePicker.execute() = False Then
  Wscript.Quit
 End If
 sFiles = oFilePicker.getFiles()
 Dim sPath
 If UBound(sFiles) > 1 Then
  ReDim sPath(UBound(sFiles) - 1)
  For I = 1 To UBound(sFiles)
   sPath(I - 1) = sFiles(0) & sFiles(I)
  Next
 Else
  ReDim sPath(0)
  sPath(0) = sFiles(0)
 End If
 getURLs_for_Open = sPath
End Function

Sub play(sURL)
 'MsgBox sURL

 Dim classSize
 Set classSize = oCoreReflection.forName("com.sun.star.beans.PropertyValue")

 Dim oDoc

 Dim args1(0)
 classSize.createObject args1(0)
 args1(0).Name = "Hidden"
 args1(0).Value = false

 On Error Resume Next
 Set oDoc = oDesktop.loadComponentFromURL(sURL, "_default", 0, args1)
 On Error Goto 0

 If Not IsObject(oDoc) Then
  MsgBox "ファイル " & sURL & " を開けませんでした。", vbOKOnly + vbCritical, "エラー発生!"
  Exit Sub
 End If

 If Not oDoc.supportsService("com.sun.star.presentation.PresentationDocument") Then
  oDoc.close False
  MsgBox "ファイル " & sURL & " は、プレゼンテーションのファイルではありません。", bOKOnly + vbCritical, "エラー発生!"
  Exit Sub
 End If

 StartPresentation oDoc
 if (oDoc.Presentation.IsFullScreen) Then
  do
   WScript.Sleep 1000
  loop While (isOnGoing(oDoc))
  oDoc.close True
 End If

End Sub

Function isOnGoing(oDoc)
 Dim sTitle
 Dim oComponents
 Dim nCount
 Dim oEnumeration
 Dim oElement

 sTitle = getTitle(oDoc)
 nCount = 0
 Set oComponents = oDesktop.getComponents()
 if oComponents.hasElements() Then
  Set oEnumeration = oComponents.createEnumeration()
  do while (oEnumeration.hasMoreElements())
   Set oElement = oEnumeration.nextElement()
   if oElement.supportsService("com.sun.star.presentation.PresentationDocument") Then
    If getTitle(oElement) = sTitle Then
     nCount = nCount + 1
    End If
   end if
  loop
 End If
 isOnGoing = (nCount >= 2)
End Function

Function getTitle(oElement)
 Dim xController
 Dim xFrame

 Set xController = oElement.getCurrentController()
 Set xFrame = xController.getFrame()
 getTitle = xFrame.Title
End Function

Sub StartPresentation(oDoc)
 Dim oPresentation
 Set oPresentation = oDoc.getPresentation()
 ' http://api.openoffice.org/docs/common/ref/com/sun/star/presentation/Presentation.html
 oPresentation.AllowAnimations = True
 oPresentation.CustomShow = ""
 oPresentation.FirstPage = ""
 oPresentation.IsAlwaysOnTop = True
 oPresentation.IsAutomatic = False
 oPresentation.IsEndless = False
 oPresentation.IsFullScreen = True
 'oPresentation.IsLivePresentation = 
 oPresentation.IsMouseVisible = True
 'oPresentation.IsShowAll = True
 oPresentation.IsTransitionOnClick = True
 oPresentation.IsShowLogo = False
 oPresentation.Pause = 1
 oPresentation.StartWithNavigator = False
 oPresentation.UsePen = True
 oPresentation.Start()
End Sub

Programming OpenOffice.org with Visual Basic