|
|
应该能满足你。
- 'Option Explicit '要求变量声明
- Dim ZoomOut As Boolean '缩放
- Dim sldW, sldH As Single
- Dim shpW, shpH, shpL, shpT As Single
- Sub effe()
- Dim shp1 As Shape
- Dim sld As Slide
- Set sld = ActivePresentation.Slides(1)
- Set shp1 = sld.Shapes("Picture 8")
- Set eff = sld.TimeLine.MainSequence.AddEffect(Shape:=shp1, effectId:=msoAnimEffectBlinds, Trigger:=msoAnimTriggerWithPrevious)
- ShapesScaling shp1
- End Sub
- Sub ShapesScaling(ByVal shp As Shape)
- '获取幻灯片的宽度与高度
- With Application.ActivePresentation.PageSetup
- sldW = .SlideWidth
- sldH = .SlideHeight
- End With
-
- '防止幻灯片播放过程中意外终止 但图片处于放大状态
- If shp.Width = sldW And shp.Height = sldH Then ZoomOut = True
- If ZoomOut = True Then '缩小
- ZoomOut = Not ZoomOut
- '还原图形大小
- 'Call dhxg
- With shp
- .Left = shpL
- .Top = shpT
- .Width = shpW
- .Height = shpH
- End With
- Else '首次单击触发放大 ZoomOut初始为false
- ZoomOut = Not ZoomOut
- '保存图形原来的左顶宽高
- With shp
- shpL = .Left
- shpT = .Top
- shpW = .Width
- shpH = .Height
- End With
- '放大图形至全屏 并置顶
- 'Call dhxg
- With shp
- .Left = 0
- .Top = 0
- .Width = sldW
- .Height = sldH
- .ZOrder msoBringToFront
- End With
- End If
- End Sub
复制代码
|
|
