|
Public Const shapeName As String = "ProgressShape" |
|
|
|
' Also set the alternative text field, this is checked during clearing such that one can copy a |
|
' shape and change this text in order to re-use the shapes |
|
Public Const shapeAltText As String = "ProgressShape, remove this if you do not want it to be auto cleared" |
|
|
|
' Lookup table for the circle colors |
|
Function Color(ByVal index As Integer) |
|
Color = RGB(0, 0, 0) |
|
' Correct for nr of skipped begin slides |
|
index = index - skipBeginNrSlides |
|
Select Case index |
|
Case Is <= 3 |
|
Color = RGB(255, 164, 32) |
|
Case Is <= 5 |
|
Color = RGB(20, 141, 137) |
|
Case Is <= 10 |
|
Color = RGB(240, 70, 20) |
|
Case Is <= 15 |
|
Color = RGB(29, 130, 32) |
|
Case Is <= 100 |
|
Color = RGB(255, 164, 32) |
|
End Select |
|
|
|
End Function |
|
|
|
' Remove all shapes with the circleName name from all slides |
|
Function ClearProgressBar() |
|
On Error Resume Next |
|
With ActivePresentation |
|
For i = 1 To .Slides.Count |
|
Do |
|
found = False |
|
For Each Shp In .Slides(i).Shapes |
|
If Shp.Name = shapeName And Shp.AlternativeText = shapeAltText Then |
|
Shp.Delete |
|
found = True |
|
End If |
|
Next Shp |
|
Loop Until found = False |
|
Next i: |
|
End With |
|
End Function |
|
|
|
Sub AddProgressCircle() |
|
' Always clear first |
|
ClearProgressBar |
|
On Error Resume Next |
|
With ActivePresentation |
|
|
|
' Parameters |
|
skipBeginNrSlides = 1 |
|
skipEndNrSlides = 0 |
|
totalBarWidth = .PageSetup.SlideWidth / 2# |
|
circleLineWidth = 0.2 |
|
interCircleDistance = 4# |
|
distFromRight = 12.5 |
|
distFromBottom = 12.5 |
|
|
|
'Count nr visible |
|
nrVisible = 0 |
|
For i = 1 To .Slides.Count |
|
If .Slides(i).SlideShowTransition.Hidden = msoFalse Then nrVisible = nrVisible + 1 |
|
Next i: |
|
|
|
' Calculated parameters |
|
nrProgress = nrVisible - skipBeginNrSlides - skipEndNrSlides |
|
interCircleDistanceSum = interCircleDistance * nrProgress |
|
circleSize = (totalBarWidth - interCircleDistanceSum) / nrProgress |
|
widthPerCirclePlusSpacing = circleSize + interCircleDistance |
|
startX = .PageSetup.SlideWidth - circleSize - totalBarWidth - distFromRight |
|
startY = .PageSetup.SlideHeight - circleSize - distFromBottom |
|
|
|
' Draw the progress bar |
|
n = 0 |
|
' Loop through all slides |
|
For i = 1 To .Slides.Count |
|
' Draw circles when current slide is not hidden and total number of circles have not yet been drawn |
|
If .Slides(i).SlideShowTransition.Hidden = msoFalse And n < nrProgress + skipBeginNrSlides Then |
|
' Keep track of current progress, i.e. nr of visible slides |
|
n = n + 1 |
|
If n <= skipBeginNrSlides Then GoTo ContinueLoop |
|
|
|
' Loop through all the progress circles for the slide |
|
For k = 1 To nrProgress |
|
' Vary the x position based on the circle size and the inter circle distance |
|
x = startX + (k * widthPerCirclePlusSpacing) |
|
|
|
' Determine the color via the lookup table |
|
currentColor = Color(k) |
|
|
|
' Draw circle outlines |
|
Set totProgCircle = .Slides(i).Shapes.AddShape(msoShapeOval, x, startY, circleSize, circleSize) |
|
With totProgCircle |
|
.Fill.ForeColor.RGB = RGB(255, 255, 255) |
|
.Line.Visible = msoTrue |
|
.Line.ForeColor.RGB = currentColor |
|
.Line.Weight = circleLineWidth |
|
.Name = shapeName |
|
.AlternativeText = shapeAltText |
|
End With |
|
|
|
' Draw half filled in circle for current slide |
|
If k = n - skipBeginNrSlides Then |
|
halfCircleSize = (circleSize / 2#) |
|
fourthCircleSize = (circleSize / 4#) |
|
Set totProgCircle = .Slides(i).Shapes.AddShape(msoShapeOval, x + fourthCircleSize, startY + fourthCircleSize, halfCircleSize, halfCircleSize) |
|
With totProgCircle |
|
.Fill.ForeColor.RGB = currentColor |
|
.Line.Visible = msoTrue |
|
.Line.ForeColor.RGB = currentColor |
|
.Line.Weight = circleLineWidth |
|
.Name = shapeName |
|
.AlternativeText = shapeAltText |
|
End With |
|
' Draw filled in circle for past slides |
|
ElseIf k <= n - skipBeginNrSlides Then |
|
Set totProgCircle = .Slides(i).Shapes.AddShape(msoShapeOval, x, startY, circleSize, circleSize) |
|
With totProgCircle |
|
.Fill.ForeColor.RGB = currentColor |
|
.Line.Visible = msoTrue |
|
.Line.ForeColor.RGB = currentColor |
|
.Line.Weight = circleLineWidth |
|
.Name = shapeName |
|
.AlternativeText = shapeAltText |
|
End With |
|
End If |
|
|
|
|
|
Next k: |
|
End If |
|
ContinueLoop: |
|
Next i: |
|
End With |
|
End Sub |
|
|
|
Sub RemProgressCircle() |
|
ClearProgressBar |
|
End Sub |
@OkkeHendriks I really like your progress bar circles. How can edit the parameters that the progress circles match the number of slides for the particular section. How are the number of circles and colors determined? Thanks in advance