Teilkreis in PowerPoint via VBA anpassen (für Funktion á la TimeTimer)

  • PowerPoint

Es gibt 1 Antwort in diesem Thema. Der letzte Beitrag () ist von Garageman.

    Teilkreis in PowerPoint via VBA anpassen (für Funktion á la TimeTimer)

    Hallo, lieber VB-Freunde.

    Ich habe kaum Erfahrung in VBA, suche aber trotzdem eine Lösung für einen analogen Timer in PowerPoint (in der Art des bekannten TimeTimers), um in meinen Scrum Events den Status der aktuellen Timebox anzeigen zu können.
    Gestern habe ich mir erste Lösung gebaut, die basierend auf einer auf Slide 1 in einer Textbox "timebox" hinterlegten Zeit in Minuten einen Balken auf jeder Seite der aktuellen Präsentation mit der Zeit von 0 auf 100% anwachsen lässt.
    Das VBA Macro wir gestartet, wenn der Ablaufbalken initial angeklickt wird (Starttime), dann wird die Timebox daraufaddiert und der Var EndTime zugewiesen. Recht simpel.

    Nun aber möchte ich aus dieser Bar eine analoge Anzeige der Art des TimeTimers machen:
    Ein weißer Teilkreis liegt über einem roten Kreis.
    Der eine Parameter des weißen Teilkreises soll sich von 0 bis 359 mit dem Lauf der Zeit verändern (der zweite Parameter soll natürlich fix bleiben).

    Ich stehe etwas auf dem Schlauch mit der Adressierung der Parameter des Shapes, denn ich finde dazu nichts wirklich logisches im Netz-der-Netze.
    Gefunden habe ich "app.ActiveWindow.Selection.ShapeRange.Adjustments(1)" und "...(2)", die mit Werten von 0 bis 360 belegt werden können.
    Diese Parameter scheinen aber nicht unter VBA zu funktionieren - oder ich bin einfach zu unerfahren mit VBA...

    Ganz simpel zum Einstieg und Verstehen der Adressierung der beiden Argumente wäre:


    Quellcode

    1. Sub TimeTimer()
    3. Dim Percentage As Long
    4. Dim SlideNumber As Integer
    5. Percentage = 0.25
    6. SlideNumber = 1
    8. ActivePresentation.Slides(SlideNumber).Shapes("elapsed_time").Adjustments(2) = 360 * Percentage
    9. ActivePresentation.Slides(SlideNumber).Shapes("elapsed_time").Adjustments(1) = 0
    11. End Sub



    Kann mir hier jemand helfen?

    Das wäre fein!

    .:. lutz

    Ok, I found the solution after posting by inquiry - sometimes, asking a question activates my brain even more ;)

    The solution for my very specific request is:

    Quellcode

    1. ​Sub countdown()
    3. Dim Starttime As Date
    4. Starttime = Now() 'The current time, start the countdown by clicking on the countdown field after starting the presentation'
    6. Dim count As Integer
    7. count = ActivePresentation.Slides(1).Shapes("timebox").TextFrame.TextRange 'timebox in minutes has to be entered on first slide in the shape called "timebox" anywhere on the presentation (outside the visible part ;-) )'
    9. Dim pos_x, pos_y, diamater_x, diameter_y As Integer
    10. pos_x = 100
    11. pos_y = 100
    12. diameter_x = 100
    13. diameter_y = 100
    15. Dim Finishtime As Date
    16. Finishtime = DateAdd("n", count, Starttime)
    18. Dim time As Double
    19. time = CDbl(Finishtime)
    21. Dim slideCount As Long
    22. slideCount = ActivePresentation.Slides.count 'Number of slides in this presentation'
    24. Dim shp As Shape
    25. For i = 1 To slideCount
    26. 'chili-roten Kreis zeichnen, hinterste Ebene
    27. Set shp = ActivePresentation.Slides(i).Shapes.AddShape(msoShapeOval, pos_x, pos_y, diameter_x, diameter_y)
    28. With shp
    29. .Name = "background_red_circle"
    30. .Line.Visible = msoFalse
    31. .Fill.Visible = msoTrue
    32. .Fill.ForeColor.RGB = RGB(194, 24, 7)
    33. End With
    35. 'Kuchendiagramm zeichnen, weiß (bzw. Farbe des Hintergrundes), über dem roten Kreis, Startwert auf -45 und 360 setzen (12 Uhr)
    36. Set shp = ActivePresentation.Slides(i).Shapes.AddShape(msoShapePie, pos_x, pos_y, diameter_x, diameter_y)
    37. With shp
    38. .Name = "elapsed_time"
    39. .Line.Visible = msoFalse
    40. .Fill.Visible = msoTrue
    41. .Fill.ForeColor.RGB = vbWhite
    42. End With
    43. ActivePresentation.Slides(i).Shapes("elapsed_time").Adjustments(1) = -90
    44. ActivePresentation.Slides(i).Shapes("elapsed_time").Adjustments(2) = 270
    46. 'schwarze dicke Umrandung zeichnen, oberste Ebene
    47. Set shp = ActivePresentation.Slides(i).Shapes.AddShape(msoShapeOval, pos_x, pos_y, diameter_x, diameter_y)
    48. With shp
    49. .Name = "framed_circle"
    50. .Line.Visible = msoTrue
    51. .Line.Weight = 3
    52. .Fill.Visible = msoFalse
    53. .Line.ForeColor.RGB = vbBlack
    54. End With
    56. Next i
    58. Do Until time < CDbl(Now())
    59. DoEvents
    61. For i = 1 To slideCount
    62. On Error Resume Next
    63. ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange.Paragraphs(i).Font.Color.RGB = vbWhite
    64. ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange = Format((time - CDbl(Now())), "hh:mm:ss")
    66. PastTime = Now() - Starttime
    67. TotalTime = Finishtime - Starttime
    69. ActivePresentation.Slides(i).Shapes("ProgressBar").Delete
    70. Set shp = ActivePresentation.Slides(i).Shapes.AddShape(msoShapeRectangle, 0, ActivePresentation.PageSetup.SlideHeight - 12, ActivePresentation.PageSetup.SlideWidth * PastTime / TotalTime, 12)
    71. shp.Name = "ProgressBar"
    72. 'Fortschrittsbalken "Timebox" in DZ-Bank-Orange (242, 109, 58) zeichnen
    73. shp.Fill.ForeColor.RGB = RGB(242, 109, 58)
    74. shp.Line.ForeColor.RGB = RGB(242, 109, 58)
    76. ActivePresentation.Slides(i).Shapes("elapsed_time").Adjustments(1) = -90 + 360 * PastTime / TotalTime
    77. ActivePresentation.Slides(i).Shapes("elapsed_time").Adjustments(2) = 270
    78. Next i
    80. If time < Now() Then
    81. For i = 1 To slideCount
    82. ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange.Paragraphs(i).Font.Color.RGB = vbRed
    83. ActivePresentation.Slides(i).Shapes("countdown").TextFrame.TextRange = "ENDE"
    84. Next i
    85. End If
    87. Loop
    89. ' Aufräumen
    90. For i = 1 To slideCount
    91. ActivePresentation.Slides(i).Shapes("ProgressBar").Delete
    92. ActivePresentation.Slides(i).Shapes("framed_circle").Delete
    93. ActivePresentation.Slides(i).Shapes("elapsed_time").Delete
    94. ActivePresentation.Slides(i).Shapes("background_red_circle").Delete
    95. Next i
    97. End Sub


    Auf der ersten Slide der PPTM (M für Macro) muss ein Shape mit dem Namen "timebox" existieren (außerhalb des sichtbaren Bereichs sinnvoller Weise) mit dem Wert für die Timebox in Minuten.
    Das Macro "countdown" wird an ein Shape gebunden, dass sich auf der ersten Slide befindet (es wird beim Start auf alle anderen Slide kopiert)
    Nach dem Start des Count Downs wird die Zeit in Sekunden in der Box rechts oben numerisch herunter gezählt.
    Am unteren Bildschirmrand baut sich eine Bar auf in Relation zur abgelaufenen Zeit
    Links oben erscheint der "TimeTimer", der ebenfalls die abgelaufene Zeit anzeigt.

    Maybe someone wants to reuse it.

    Cheers.

    .:. lutz

Facebook
Telefonspende