Следующее сработало для меня. Сначала установите надстройку AutoEvents. В приведенном ниже примере используется непрерывная презентация PowerPoint из 2 слайдов (если у вас есть больше, измените оператор if в третьем макросе на номер вашего последнего слайда). Создайте три подпрограммы, которые делают то же самое:
- Sub Auto_ShowBegin()
- Sub Auto_Open()
- Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Auto_ShowBegin() и Auto_Open() одинаковы.
Sub Auto_ShowBegin()
Dim sldTemp As Slide
Dim lngTemp As Long
Dim lngCount As Long
Dim myImage As Shape
For Each sldTemp In ActivePresentation.Slides
For lngCount = sldTemp.Shapes.Count To 1 Step -1
With sldTemp.Shapes(lngCount)
If .Type = msoPicture Then
.Delete
End If
End With
Next
Next
Set sldTemp = ActivePresentation.Slides(1)
Set myImage = sldTemp.Shapes.AddPicture( _
FileName:="C:\Users\Name\image1.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=(ActivePresentation.PageSetup.SlideWidth / 2), _
Top:=(ActivePresentation.PageSetup.SlideHeight / 2))
myImage.Left = (ActivePresentation.PageSetup.SlideWidth / 2) - (myImage.Width / 2)
myImage.Top = (ActivePresentation.PageSetup.SlideHeight / 2) - (myImage.Height / 2)
Set sldTemp = ActivePresentation.Slides(2)
Set myImage = sldTemp.Shapes.AddPicture( _
FileName:="C:\Users\Name\image2.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=(ActivePresentation.PageSetup.SlideWidth / 2), _
Top:=(ActivePresentation.PageSetup.SlideHeight / 2))
myImage.Left = (ActivePresentation.PageSetup.SlideWidth / 2) - (myImage.Width / 2)
myImage.Top = (ActivePresentation.PageSetup.SlideHeight / 2) - (myImage.Height / 2)
End Sub
И третий макрос:
Sub OnSlideShowPageChange(ByVal SSW As SlideShowWindow)
Dim sldTemp As Slide
Dim lngTemp As Long
Dim lngCount As Long
Dim myImage As Shape
' AUTO UPDATE OF OLE LINKS MACRO
'
If SSW.View.CurrentShowPosition = 2 Then
For Each sldTemp In ActivePresentation.Slides
For lngCount = sldTemp.Shapes.Count To 1 Step -1
With sldTemp.Shapes(lngCount)
If .Type = msoPicture Then
.Delete
End If
End With
Next
Next
Set sldTemp = ActivePresentation.Slides(1)
Set myImage = sldTemp.Shapes.AddPicture( _
FileName:="C:\Users\Name\image1.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=(ActivePresentation.PageSetup.SlideWidth / 2), _
Top:=(ActivePresentation.PageSetup.SlideHeight / 2))
myImage.Left = (ActivePresentation.PageSetup.SlideWidth / 2) - (myImage.Width / 2)
myImage.Top = (ActivePresentation.PageSetup.SlideHeight / 2) - (myImage.Height / 2)
Set sldTemp = ActivePresentation.Slides(2)
Set myImage = sldTemp.Shapes.AddPicture( _
FileName:="C:\Users\Name\image2.png", _
LinkToFile:=msoFalse, _
SaveWithDocument:=msoTrue, Left:=(ActivePresentation.PageSetup.SlideWidth / 2), _
Top:=(ActivePresentation.PageSetup.SlideHeight / 2))
myImage.Left = (ActivePresentation.PageSetup.SlideWidth / 2) - (myImage.Width / 2)
myImage.Top = (ActivePresentation.PageSetup.SlideHeight / 2) - (myImage.Height / 2)
End If
End Sub