PowerPoint VBA - voortgangsindicator

Voortgangsindicator

Met behulp van de onderstaande instructie kan een voortgangsindicator - over de gehele presentatie heen - worden ingevoegd:

  • Kopieer de onderstaande code;
  • Ga naar PowerPoint en open de gewenste presentatie;
  • Druk op [ALT] + [F11] om naar de Visual Basic Editor te gaan;
  • Ga in de menubalk naar [Invoegen] en druk op [Module];
  • Druk op [CTRL] + [V] om de code te plakken;
  • Druk weer op [ALT] + [F11] om terug te keren;
  • Activeer het tabblad [Beeld] en druk in de groep [Macro’s] op de knop [Macro’s];
  • Selecteer de macro ‘maakVoortgangsindicator’ en druk op de knop [Uitvoeren].

Tip: kies voor de macro 'verwijderVoortgangsindicator' om de voortgangsindicator weer te verwijderen.

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 1-1-2016
' Object        : Module1
' Doel          : voortgangsindicator plaatsen en verwijderen in PowerPoint presentatie
' Verwijzing    :
' Bron          : https://gist.github.com/PiiXiieeS/7181980
'-----------------------------------------------------------------------------------------------------------------------
Option Explicit
 
'module variabelen declaren
Dim lngDia As Long           'huidige dia
Dim lngAantal As Long        'totaal aantal dia's
 
'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 1-1-2016
' Type          : Subroutine
' Opmerking     : voortgangsindicator plaatsen in alle dia's (1e dia optioneel)
'-----------------------------------------------------------------------------------------------------------------------
Sub maakVoortgangsindicator()
    
'   Variabelen declareren
    Dim intLinks As Integer         'positie
    Dim intHoogte As Integer
    Dim intBoven As Integer
    
    Dim shpRechthoek As Shape       'vorm voortgangsindicator = rechthoek
 
    Dim intDia1 As VbMsgBoxResult   '1e dia optioneel
       
'   Variabelen initialiseren
    intLinks = 0
    intHoogte = 12
    intBoven = ActivePresentation.PageSetup.SlideHeight - intHoogte
    
    intDia1 = MsgBox("Inclusief 1e dia?", vbInformation + vbYesNo, "Voortgangsindicator")
        
    lngAantal = ActivePresentation.Slides.Count
    
'   Indien exclusief 1e dia minus 1 op totaal aantal dia's
    If intDia1 = vbNo Then lngAantal = lngAantal - 1
 
'   Itereren door alle dia's
    For lngDia = 1 To lngAantal
'       Rechthoek gepositioneerd plaatsen
        If intDia1 = vbNo Then
'           1e dia overslaan = + 1
            Set shpRechthoek = ActivePresentation.Slides(lngDia + 1). _
                Shapes.AddShape(msoShapeRectangle, intLinks, intBoven, _
                lngDia * ActivePresentation.PageSetup.SlideWidth / lngAantal, intHoogte)
        Else
'           inclusief 1e dia
            Set shpRechthoek = ActivePresentation.Slides(lngDia). _
                Shapes.AddShape(msoShapeRectangle, intLinks, intBoven, _
                lngDia * ActivePresentation.PageSetup.SlideWidth / lngAantal, intHoogte)
        End If
'       Rechthoek kleur en naam geven
        With shpRechthoek
            .Fill.ForeColor.RGB = RGB(112, 146, 191)
            .Name = "Voortgangsindicator"
        End With
    Next lngDia
 
End Sub
'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 1-1-2016
' Type          : Subroutine
' Opmerking     : voortgangsindicator verwijderen uit alle dia's
'-----------------------------------------------------------------------------------------------------------------------
Sub verwijderVoortgangsindicator()
  
    On Error Resume Next
    
    lngAantal = ActivePresentation.Slides.Count
    
'   Itereren door alle dia's
    For lngDia = 1 To lngAantal
        ActivePresentation.Slides(lngDia).Shapes("Voortgangsindicator").Delete
    Next lngDia
    
End Sub