1

パワポのライブラリを下記ページより、スクリプトを拝借して使用させていただいております。

【ライブラリ公開】PowerPoint関連ライブラリ

-----------------------------------------------------------

ライブラリ名:
PowerPoint操作(画像挿入)
 
ライブラリの注釈:
■機能概要
指定ファイルが開いていない場合はファイルを開き、
既にファイルを開いていれば表示スライドに画像を挿入します。
 
■設定項目
[ファイル名]:操作対象ファイルを絶対パスで指定してください。
[画像名]  :画像ファイルを絶対パスで指定してください。
 
[新規スライド]:スライドマスタにて指定されたプレースフォルダーを
        削除する場合、”はい”を選択します。
※”いいえ”を選択し、対象スライドにコンテンツまたは
 図のプレースフォルダーがある場合、
 画像はプレースフォルダーの位置に挿入されます。
 
以下は画像を挿入する位置とサイズをポイント数で指定。
※値をしていない場合エラーとなります。
[横位置]:スライド左上隅から横位置を指定します。
[縦位置]:スライド左上隅から縦位置を指定します。
[高さ] :画像の高さを指定します。
[幅]  :画像の幅を指定します。
 
ライブラリのスクリプト:
' ====引数を取得==================================================
fname = !ファイル名!
iname = !画像名!
delFla = !新規スライド|はい,いいえ!
shLeft = !横位置!
shTop = !縦位置!
shHeight = !高さ!
shWidth = !幅!

If shLeft = "" or shTop = "" or shHeight = "" or shWidth = "" Then
Err.Raise 1, "", "値が設定されていません。"
End if

' ====指定されたファイルを確認====================================
On Error Resume Next
' Powerpointオブジェクトを取得する
Set objPpt = GetObject(, "PowerPoint.Application")

If objPpt is Nothing then
Set objPpt = CreateObject("PowerPoint.Application")
On Error Goto 0
End if

If objPpt is Nothing then
Err.Raise 1, "", "指定されたPowerPointアプリケーションが開けません。"
End if

' 対象のファイルが開いているか確認
For i = 1 To objPpt.presentations.Count
openFP = objPpt.presentations(i).fullname
If StrComp(openFP, fname, 1) = 0 Then
Set tarPpt = objPpt.presentations(i)
fileExist = True
Exit for
End If
Next

' 対象のファイルが開いていない場合は開く
If fileExist = False Then
' PowerPointファイルを開く
Set tarPpt = objPpt.Presentations.Open(fname)
If Err.Number <> 0 Then
On Error Goto 0
' オブジェクト解放
Set tarPpt = Nothing
Set objPpt = Nothing
Err.Raise 1, "", "指定されたPowerPointファイルが開けません。"
End If
End If

' 対象のファイルを最前面化
Set fso = CreateObject("Scripting.FileSystemObject")
fileName = fso.getFileName(fname)

Set WShell = WScript.CreateObject("WScript.Shell")
WShell.AppActivate fileName

' スライド確認
Set objSld = tarPpt.Slides
Set objPpx = objSld.FindBySlideID(tarPpt.Windows(1).Selection.SlideRange.SlideID)
sldcun = objPpx.SlideIndex
objSld(sldcun).Select

' 新規スライドの場合にコンテンツのプレースフォルダーを削除
Set objShp = objSld(sldcun).Shapes
shacun = objShp.Placeholders.Count
If shacun > 1 and delFla = "はい" Then
For i = shacun To 2 Step -1
objShp(i).Delete
Next
End If

' 画像挿入
Set objSh = objShp.AddPicture(iname,False,True,shLeft,shTop)
With objSh
.LockAspectRatio = True
If .Width > .Height Then
.Width = shHeight
Else
.Height = shWidth
End If
.Select
End With

On Error Goto 0

Set objSh = Nothing
Set objShp = Nothing
Set fso = Nothing
Set WShell = Nothing
Set objPpx = Nothing
Set objSld = Nothing
Set tarPpt = Nothing
Set objPpt = Nothing
----------------------------------------------

画像の張り付けができてとても便利なライブラリで大変助かっております。

ここで少し相談なのですが、掲題のとおり、このスクリプトを少し改変して

画像を張り付ける際に、最背面になるようにしたいと思っています。

当方で以下のように改変して張り付けた画像を最背面にしようと思ったのですが

なかなかうまくいきません。

----------------------------------------------

' 画像挿入
Set objSh = objShp.AddPicture(iname,False,True,shLeft,shTop)
With objSh
.LockAspectRatio = True

.Selection.ShapeRange.ZOrder msoSendToBack <<<<<< ここを追加しています。

If .Width > .Height Then
.Width = shHeight
Else
.Height = shWidth
End If
.Select
End With

---------------------------------------------

どうかご助力いただけないでしょうか。

この質問は解決済みのためクローズされています。
Zawawa 新しいコメントを投稿
回答とコメントは、会員登録(無料)で閲覧できるようになります。