幻灯片进度条

weiyingde

Sub 幻灯片进度条()
颜色1 = Array(vbRed, vbBlack, vbGreen, vbYellow, vbMagenta, vbBlue, vbCyan)
颜色2 = Array(vbBlack, vbGreen, vbYellow, vbMagenta, vbBlue, vbCyan, vbRed)
n = ActivePresentation.Slides.Count
i = ActivePresentation.SlideShowWindow.View.CurrentShowPosition
SlideMaster.Label1.Caption = "当 前" & vbCrLf & IIf(i = n, "结 束", i & "/" & n)
j = i Mod 8 + 1
w = ActivePresentation.PageSetup.SlideWidth - 80
t = ActivePresentation.PageSetup.SlideHeight - 20
'For Each shp In SlideMaster.Shapes
'  If shp = .Name = "进度条" Then
' If Not shp Is Nothing Then
  With ActivePresentation.SlideMaster.Shapes("进度条")
     .Width = w * i / n
     .Fill.BackColor.RGB = 颜色1(j)
     .TextFrame.TextRange.Text = Format(i / n, "0%")
     .Fill.ForeColor.RGB = 颜色2(j)
   End With
'Else
'   With ActivePresentation.SlideMaster.Shapes.AddShape(1, 72, t - 10, w * i / n, 30)
'        .Name = "进度条"
'        .Fill.BackColor.RGB = 颜色1(j)
'        .TextFrame.TextRange.Text = Format(i / n, "0.0%")
'        .Fill.ForeColor.RGB = 颜色2(j)
'   End With
'End If
'Next
End Sub

leikaiyi123

我也来一个电池进度条

leikaiyi123

今天发现为什么有时Sub onSlideShowPageChange()这个不执行，按一下alt+F11就能行了？

leon3131

感谢楼主的分享！！！

BigTecDream

一般般。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。。

萤火虫-2015

太牛了谢谢分享

萤火虫-2015

leikaiyi123 发表于 2019-5-22 10:06
我也来一个电池进度条

谢谢分享全是能人