Sub ProgressBar() ' by dukenuke@ ' Sun Jul 11 00:06:13 2010 ' ' Update by oicu#lsxk.org ' 2010/9/12 20:44 ' 对首页以及隐藏幻灯片进行处理
Dim mySlides As Slides Dim pageBar As ShapeRange Dim pageSHower As Shape Dim pageWidth, pageHeight, pageStep Dim MyArray() As Variant '增加一个数组以便统计隐藏的幻灯片 Dim i, j, k j = 0 k = 0
Set mySlides = Application.ActivePresentation.Slides
pageWidth = Application.ActivePresentation.SlideMaster.Width pageHeight = Application.ActivePresentation.SlideMaster.Height ' pageStep = pageWidth / mySlides.Count
ReDim MyArray(mySlides.Count, 0) For i = 1 To mySlides.Count '统计隐藏的幻灯片数 If mySlides.Item(i).SlideShowTransition.Hidden = True Then j = j + 1 MyArray(i, 0) = 1 Else MyArray(i, 0) = 0 End If Next
'除去首页和隐藏的幻灯片后计算进度条长度增量 If mySlides.Count - 1 - j > 0 Then pageStep = pageWidth / (mySlides.Count - 1 - j) Else pageStep = 0 End If
On Error Resume Next
For i = 1 To mySlides.Count ' 改为从1开始 k = k + MyArray(i, 0) ' 计算当前隐藏的幻灯片数 Set pageBar = mySlides.Item(i).Shapes.Range(Array()) Set pageBar = _ mySlides.Item(i).Shapes.Range(Array("RectanglePageNum"))
If IsNull(pageBar) Or pageBar.Count = 0 Then GoTo newBar Set pageSHower = pageBar.Item(1) GoTo nextPage
newBar: Set pageSHower = mySlides.Item(i).Shapes.AddShape( _ msoShapeRectangle, 0, _ pageHeight - 3, i * pageStep, 3) pageSHower.Name = "RectanglePageNum"
nextPage: pageSHower.Fill.ForeColor.RGB = RGB(179, 162, 199) ' pageSHower.Fill.ForeColor.RGB = RGB(255, 255, 255) ' pageSHower.Fill.Transparency = 0.7 ' 透明度 pageSHower.Line.Visible = msoFalse ' pageSHower.Width = i * pageStep ' 计算进度条长度时除去首页和隐藏的幻灯片 pageSHower.Width = (i - 1 - k) * pageStep pageSHower.Top = pageHeight - 3 pageSHower.Left = 0 pageSHower.Height = 3 ' 删除首页和隐藏的幻灯片的进度条 If i = 1 Or MyArray(i, 0) = 1 Then pageSHower.Delete Next End Sub |