Consulting

Results 1 to 8 of 8

Thread: How to inserte progress DOTS in powerpoint 2012

  1. #1
    VBAX Newbie
    Joined
    Jun 2012
    Posts
    2
    Location

    Exclamation How to inserte progress DOTS in powerpoint 2012

    Hello !

    I'm wondering how to insert progress dots in my Power Point presentation, (NOT PROGRESS BAR, please ) which allow to view the progress of each slide in the whole presentation. I want to put them in the upper left corner of each slide.

    For example, I put 4 dots in the upper left corner of each slide, if I'm on the first or second slide, it will show one dark dots, and three blank dots. If I'm on the 5th or 6th slide, it will show 3 dark dots and one blank dot.

    Please, can someone tell me how to do this?

    I have Microsoft Office Professional Plus 2010.

    Thank you very much !

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,726
    Location
    What do you do if you're on the 19th or 20th slide?

    Paul

  3. #3
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,094
    Location
    Like Paul I'm finding it hard to imagine what you need.

    Are the dot physically added to each slide (the equivalent of adding manually)?

    Wouldn't it be more sensible to have say ten dots each one indicating 10% of the slides?
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  4. #4
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,726
    Location
    One possilble initial approach

    Run the macro as design time and it adds 4 markers and fills them in (1,2,3,4,1,2,3,4,1,2,3,4, ....)

    [vba]
    Option Explicit
    Sub AddMarkers()
    Dim oPres As Presentation
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim aBox(0 To 3) As Shape
    Dim i As Long
    Set oPres = ActivePresentation
    For Each oSlide In oPres.Slides
    On Error Resume Next
    oSlide.Shapes("Box0").Delete
    oSlide.Shapes("Box1").Delete
    oSlide.Shapes("Box2").Delete
    oSlide.Shapes("Box3").Delete
    On Error GoTo 0
    Next

    For Each oSlide In oPres.Slides
    For i = 0 To 3
    Set aBox(i) = oSlide.Shapes.AddShape(msoShapeRectangle, 12 * i, 0, 12, 12)
    aBox(i).Name = "Box" & i
    aBox(i).Fill.ForeColor.RGB = RGB(0, 0, 0)
    aBox(i).Line.Weight = 1
    aBox(i).Line.ForeColor.RGB = RGB(255, 255, 255)
    Next i
    Next

    For Each oSlide In oPres.Slides
    i = (oSlide.SlideNumber Mod 4)
    oSlide.Shapes("Box" & i).Fill.ForeColor.RGB = RGB(255, 0, 0)
    Next
    End Sub
    [/vba]

    Pretty crude, but it might help. The attachment has a sample result

    (Remove the .zip part)

    Paul
    Attached Files Attached Files

  5. #5
    VBAX Newbie
    Joined
    Jun 2012
    Posts
    2
    Location
    Hello Paul, thank you for your response !
    I downloaded the attachment. But how should I proceed to open XML files found in this attachment ?
    Are XML files sort of presentation ?

  6. #6
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,726
    Location
    just rename the file Dots.pptm

    You can't load a .pptm file here so you have to fool it a little

    It really is a Macro Enabled Powerpoint

    It is not dynamic. You'd have to run the macro or your improved version to add the dots each time you add or delete slide

    Paul

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,726
    Location
    Also, this as is just fills in a single dot, leaving the other 3 empty.

    Personally, I think John's approach is better: insert 10 dots, and fill in based on the percentage of slides displayed. So on the 15th slide of 45 slides total, you would have the first 3 of 10 dots filled in (=30%)

    Paul

  8. #8
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,726
    Location
    Percentage markers


    [vba]
    Sub AddMarkers_1()
    Dim oPres As Presentation
    Dim oSlide As Slide
    Dim oShape As Shape
    Dim aBox(0 To 9) As Shape
    Dim i As Long, iDots As Long
    Dim dblPercent As Double
    Set oPres = ActivePresentation
    For Each oSlide In oPres.Slides
    For i = LBound(aBox) To UBound(aBox)
    On Error Resume Next
    oSlide.Shapes("Box" & i).Delete
    On Error GoTo 0

    Set aBox(i) = oSlide.Shapes.AddShape(msoShapeRectangle, 12 * i, 0, 12, 12)
    aBox(i).Name = "Box" & i
    aBox(i).Fill.ForeColor.RGB = RGB(0, 0, 0)
    aBox(i).Line.Weight = 1
    aBox(i).Line.ForeColor.RGB = RGB(255, 255, 255)
    Next i
    Next

    For Each oSlide In oPres.Slides
    dblPercent = 100# * oSlide.SlideNumber / oPres.Slides.Count

    If dblPercent < 5# Then
    iDots = -1
    ElseIf dblPercent < 15# Then
    iDots = 0
    ElseIf dblPercent < 25# Then
    iDots = 1
    ElseIf dblPercent < 35# Then
    iDots = 2
    ElseIf dblPercent < 45# Then
    iDots = 3
    ElseIf dblPercent < 55# Then
    iDots = 4
    ElseIf dblPercent < 65# Then
    iDots = 5
    ElseIf dblPercent < 75# Then
    iDots = 6
    ElseIf dblPercent < 85# Then
    iDots = 7
    ElseIf dblPercent < 95# Then
    iDots = 8
    Else
    iDots = 9
    End If

    For i = 0 To iDots
    oSlide.Shapes("Box" & i).Fill.ForeColor.RGB = RGB(255, 0, 0)
    Next i
    Next

    MsgBox "Done adding progress dots"
    End Sub
    [/vba]
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •