VBからのPowerPointのオブジェクト変更方法

解決

Yoko 2002-07-06 03:14:17 No: 75812

はじめまして。Yokoといいます。以下のような処理を行いたいのですが、
処理2の方でどのようにしたらVBからPowerPointのオブジェクトを変更等ができるのかがわかりません。わかる方がいらっしゃったらご教授願います。

前提条件：フリーフォームで作成した○があるPowerPointのファイルがあります。

処理1：コマンドボタンを押下し、PowerPointのファイルをオープンします

処理2:オープンしたPowerPoint内のオブジェクト○の背景色を変更します。

＊＊＊現状のソース＊＊＊＊＊＊＊＊＊＊
Private Sub Command1_Click()
Dim objppt As Object

'オブジェクトの生成
Set objppt = New PowerPoint.Application
objppt.Visible = True

'パワーポイントオープン
objppt.Presentations.Open "C:\Test_PowerPoint\Test.ppt"

'ここに処理２を入れたいのです。

End Sub

ぢゃわ 2002-07-08 20:26:34 No: 75813

基本的にはPowerPointでマクロの自動作成するとそのまま使えたりします。
（そのままではＶＢで使えない場合も多々あるようですが。）

今回の場合は

        With objppt.ActiveWindow.Selection.SlideRange.Shapes(1)
            .Fill.Visible = msoTrue
            .Fill.Solid
            .Fill.ForeColor.RGB = RGB(150, 150, 150)
        End With

こんなかんじで出来ると思います。
Shapes(1)の1の値を変えることで対象とする図形を変えることができます。
ここでは色をグレイ RGB(150, 150, 150) に変更しています。
.Fill.ForeColor.RGB = vbYellow などのような書き方もできます。

Yoko 2002-07-08 23:35:22 No: 75814

ぢゃわさん、ありがとうございました。無事解決いたしましたので、参考までに
したにコードを乗せます。

Private Sub Command1_Click()

Dim objppt As Object
Dim newPres As Object
Dim sld1Shapes As Object
Dim sld2Shapes As Object
Dim i As Integer

'オブジェクトの生成
Set objppt = New PowerPoint.Application

'可視とする
objppt.Visible = True
'パワーポイントオープン
objppt.Presentations.Open "E:\Test_PowerPoint\Test.ppt"

'＊＊＊＊＊背景色変更処理
'オブジェクトのセット
'With objppt.ActivePresentation
'Set sld1Shapes = .Slides(1).Shapes(1)
'Set sld2Shapes = .Slides(1).Shapes(2)
'End With
'色変更
'With objppt.ActivePresentation
'.Slides(1).Shapes(1).Fill.ForeColor.RGB = RGB(255, 0, 0)
'.Slides(1).Shapes(2).Fill.ForeColor.RGB = RGB(128, 128, 0)
'End With
＊＊＊＊＊

'表示中のスライドの図を全コピー
objppt.ActivePresentation.Slides(1).Shapes.SelectAll
objppt.ActivePresentation.Slides(1).Copy

'新規スライドの作成
objppt.Presentations.Add WithWindow:=msoTrue
objppt.ActivePresentation.Slides.Add 1, ppLayoutBlank

'新規スライドのPresentation1への張り付け
objppt.ActivePresentation.Slides(1).Select
objppt.ActivePresentation.Slides(1).Shapes.Paste

'名前を変えて保存
objppt.ActivePresentation.SaveAs _ filename:="E:\CopyALL_Test_PowerPoint\FileNameChange.ppt"
objppt.ActivePresentation.Close

'オープンしている全プレゼンテーションのクローズ
With objppt.Presentations
    For i = .Count To 1 Step -1
        .Item(i).Close
    Next
End With

'PowerPointの終了
objppt.Quit

'オブジェクトの開放
Set objppt = Nothing

End Sub