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.

01'-----------------------------------------------------------------------------------------------------------------------
02' Auteur        : pascalterheege.nl
03' Datum         : 1-1-2016
04' Object        : Module1
05' Doel          : voortgangsindicator plaatsen en verwijderen in PowerPoint presentatie
06' Verwijzing    :
07' Bron          : https://gist.github.com/PiiXiieeS/7181980
08'-----------------------------------------------------------------------------------------------------------------------
09Option Explicit
10  
11'module variabelen declaren
12Dim lngDia As Long           'huidige dia
13Dim lngAantal As Long        'totaal aantal dia's
14  
15'-----------------------------------------------------------------------------------------------------------------------
16' Datum         : 1-1-2016
17' Type          : Subroutine
18' Opmerking     : voortgangsindicator plaatsen in alle dia's (1e dia optioneel)
19'-----------------------------------------------------------------------------------------------------------------------
20Sub maakVoortgangsindicator()
21     
22'   Variabelen declareren
23    Dim intLinks As Integer         'positie
24    Dim intHoogte As Integer
25    Dim intBoven As Integer
26     
27    Dim shpRechthoek As Shape       'vorm voortgangsindicator = rechthoek
28  
29    Dim intDia1 As VbMsgBoxResult   '1e dia optioneel
30        
31'   Variabelen initialiseren
32    intLinks = 0
33    intHoogte = 12
34    intBoven = ActivePresentation.PageSetup.SlideHeight - intHoogte
35     
36    intDia1 = MsgBox("Inclusief 1e dia?", vbInformation + vbYesNo, "Voortgangsindicator")
37         
38    lngAantal = ActivePresentation.Slides.Count
39     
40'   Indien exclusief 1e dia minus 1 op totaal aantal dia's
41    If intDia1 = vbNo Then lngAantal = lngAantal - 1
42  
43'   Itereren door alle dia's
44    For lngDia = 1 To lngAantal
45'       Rechthoek gepositioneerd plaatsen
46        If intDia1 = vbNo Then
47'           1e dia overslaan = + 1
48            Set shpRechthoek = ActivePresentation.Slides(lngDia + 1). _
49                Shapes.AddShape(msoShapeRectangle, intLinks, intBoven, _
50                lngDia * ActivePresentation.PageSetup.SlideWidth / lngAantal, intHoogte)
51        Else
52'           inclusief 1e dia
53            Set shpRechthoek = ActivePresentation.Slides(lngDia). _
54                Shapes.AddShape(msoShapeRectangle, intLinks, intBoven, _
55                lngDia * ActivePresentation.PageSetup.SlideWidth / lngAantal, intHoogte)
56        End If
57'       Rechthoek kleur en naam geven
58        With shpRechthoek
59            .Fill.ForeColor.RGB = RGB(112, 146, 191)
60            .Name = "Voortgangsindicator"
61        End With
62    Next lngDia
63  
64End Sub
65'-----------------------------------------------------------------------------------------------------------------------
66' Datum         : 1-1-2016
67' Type          : Subroutine
68' Opmerking     : voortgangsindicator verwijderen uit alle dia's
69'-----------------------------------------------------------------------------------------------------------------------
70Sub verwijderVoortgangsindicator()
71   
72    On Error Resume Next
73     
74    lngAantal = ActivePresentation.Slides.Count
75     
76'   Itereren door alle dia's
77    For lngDia = 1 To lngAantal
78        ActivePresentation.Slides(lngDia).Shapes("Voortgangsindicator").Delete
79    Next lngDia
80     
81End Sub