投稿日 | : 2004/01/21(Wed) 12:37 |
投稿者 | : ak |
Eメール | : |
URL | : |
タイトル | : VBからPowerPointを制御 |
VBから起動するのであればわざわざPowerPoint側のマクロを使用しなく
てもVB側でPowerPointを制御すれば良いのではないでしょうか?
あと起動方法ですが、ShellではなくPowerPointオブジェクトを参照して
PowerPointオブジェクトを使用する方が楽に処理できます。
サンプルを記述しておきますので参考にしてください。
(Acrobatが無いので動作確認はしていません。)
サンプル
'(*.frm) フォームにCommandButtonを1個配置してください。
'※ 参照設定「Microsoft PowerPoint X.X Object Library」
'環境:Win2K,Vb6 Ppt2K
Option Explicit
Private Sub Command1_Click()
Const sInitFilePath = "\\NMGSV003\candv\共有\PpTmpFile.tx"
Const sSaveDir = "\\Nmgsv003\PDF\PDF変換\IN\"
Call pfnConvPptToPdf(sInitFilePath, sSaveDir)
End Sub
'---------------------------------------------------------------------------
'概要 :PDFファイル変換
'パラメータ :変数名 ,IO ,型 ,説明
' :sInitFilePath ,I ,String ,設定ファイル
' :sSaveDir ,I ,String ,保存先
' :[戻り値] ,0 ,Boolean ,True:エラーなし False:エラーあり
'説明 :設定ファイル内からファイル名を取得し保存先にPDF形式で保存する
'---------------------------------------------------------------------------
Private Function pfnConvPptToPdf(ByVal sInitFilePath As String, ByVal sSaveDir As String) As Boolean
Dim ii As Integer
Dim iFreeFile As Integer 'フリーファイル番号
Dim sPptFile As String 'PPTファイル
Dim sPsFile As String 'PSファイル
Dim sTmp() As String
Dim oApp As PowerPoint.Application 'PowerPoint Object
On Local Error GoTo Error_Handler
pfnConvPptToPdf = False
ReDim sTmp(0)
'PowerPoint起動
Set oApp = CreateObject("PowerPoint.Application")
oApp.Visible = True
'空きファイル番号を取得
iFreeFile = FreeFile()
Open sInitFilePath For Input As #iFreeFile
Do While Not EOF(iFreeFile)
Input #iFreeFile, sPptFile
sPsFile = Dir(sPptFile, vbNormal)
If sPsFile = "" Or sPptFile = "" Then
'ファイルがない場合はバックアップ
ReDim Preserve sTmp(UBound(sTmp) + 1)
sTmp(UBound(sTmp)) = sPptFile
Else
'PDFファイルに変換
'拡張子を「ppt」から「ps」に変換
sPsFile = sSaveDir & Replace(UCase(sPsFile), ".PPT", ".PS")
With oApp.Presentations.Open(sPptFile)
With .PrintOptions 'プリンタ設定
.RangeType = 1
.NumberOfCopies = 1
.Collate = True
.OutputType = 1
.PrintHiddenSlides = True
.PrintColorType = 1
.FitToPage = False
.FrameSlides = False
.HandoutOrder = 2
.ActivePrinter = "Acrobat Distiller"
End With
Call .PrintOut(, , sPsFile) 'ファイル出力
Call .Close 'Presentation終了
End With
End If
Loop
Close #iFreeFile
Call oApp.Quit 'PowerPoint終了
iFreeFile = FreeFile()
Open sInitFilePath For Output As #iFreeFile
For ii = 1 To UBound(sTmp)
Print #iFreeFile, sTmp(ii)
Next ii
Close iFreeFile
pfnConvPptToPdf = True
Exit Function
'===== エラー処理 ==========================================================
Error_Handler:
MsgBox "エラー番号:" & Err.Number & vbCrLf & vbCrLf & "エラー内容:" & _
Err.Description, vbCritical
Err.Clear
End Function