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 | '----------------------------------------------------------------------------------------------------------------------- |
09 | Option Explicit |
10 | |
11 | 'module variabelen declaren |
12 | Dim lngDia As Long 'huidige dia |
13 | Dim 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 | '----------------------------------------------------------------------------------------------------------------------- |
20 | Sub 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 | |
64 | End Sub |
65 | '----------------------------------------------------------------------------------------------------------------------- |
66 | ' Datum : 1-1-2016 |
67 | ' Type : Subroutine |
68 | ' Opmerking : voortgangsindicator verwijderen uit alle dia's |
69 | '----------------------------------------------------------------------------------------------------------------------- |
70 | Sub 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 | |
81 | End Sub |