1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120
| Option Explicit
Sub NumeroterDiapos() 'numérotation des diapos
'D'origine, Powerpoint attribue dans le masque et les dispositions "Espace
'réservé du numéro de diapositive 5", 5 n° d'ordre pouvant varier si la zone
'est effacée puis recréée
Dim preMac As Presentation 'présentation avec macros
Dim preNum As Presentation 'présentation à numéroter
Dim i As Integer, j As Integer
Dim shaFormCour As Shape 'forme courante
'Dim strLook As String 'look de la pagination N / M
Dim PrePresCour As Presentation 'présentation courante
'conversion point/centimètre
Const ConvPoinCm As Single = 0.0352778
'================Distinction entre les 2 présentations ouvertes================
If Application.Presentations.Count = 2 Then
'PrePresCour.Slides(1).HeadersFooters.Footer.Visible = T signifie que la
'case Insertion > En-tête/pied > Pied de page est cochée. Si elle ne l'est
'pas, accéder au pied de page renvoie une erreur --> nécessité de tester
'cette case avant de tester la valeur du texte du pied de page
If Presentations(1).Slides(1).HeadersFooters.Footer.Visible Then
'tester en 2 étapes, sinon erreur !
If Presentations(1).Slides(1).HeadersFooters.Footer.Text = "Numérotation diaporama" Then
Set preMac = Presentations(1)
Set preNum = Presentations(2)
Else
Set preNum = Presentations(1)
Set preMac = Presentations(2)
End If
Else
Set preNum = Presentations(1)
Set preMac = Presentations(2)
End If
Else
MsgBox "Le présent diaporama ne fonctionne qu'avec un seul autre diaporama ouvert." & _
vbCrLf & "C'est ce dernier qui sera examiné.", vbInformation
Exit Sub
End If
'==effacement dans chaque MASQUE de la zone de pagination d'origine si existe==
For i = 1 To preNum.Designs.Count
For Each shaFormCour In preNum.Designs(i).SlideMaster.Shapes
'si forme courante est un "espace réservé" (msoPlaceholder, valeur numérique 14)
'si forme courante est un "espace réservé" de type n° de diapo (ppPlaceholderSlideNumber, valeur numérique 13)
'MicroSoft attribue à cet espace recevant le n° de diapo dans le masque
'l'appellation "Slide Number Placeholder" dans le code VBA
'ou "Espace réservé du numéro de diapositive N" dans Powerpoint
If shaFormCour.Type = msoPlaceholder Then
If shaFormCour.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
shaFormCour.Delete
End If
End If
Next shaFormCour
Next i
'==========effacement dans chaque DISPOSITION de la zone de pagination=========
For i = 1 To preNum.Designs.Count
For j = 1 To preNum.Designs(i).SlideMaster.CustomLayouts.Count
For Each shaFormCour In preNum.Designs(i).SlideMaster.CustomLayouts(j).Shapes
If shaFormCour.Type = msoPlaceholder Then
If shaFormCour.PlaceholderFormat.Type = ppPlaceholderSlideNumber Then
shaFormCour.Delete
Exit For
End If
End If
Next shaFormCour
Next j
Next i
'(re)création dans chaque MASQUE de la zone réservée de pagination avec le nombre total de diapo
For i = 1 To preNum.Designs.Count
'La méthode Shapes.AddPlaceholder ne fonctionne pas sous PWP 2007
preNum.Designs(i).SlideMaster.Shapes.AddPlaceholder(ppPlaceholderSlideNumber, _
Round(0.06 / ConvPoinCm, 2), _
preNum.PageSetup.SlideHeight - Round(1 / ConvPoinCm, 2), _
Round(1.7 / ConvPoinCm, 2), _
Round(1 / ConvPoinCm, 2)).Name = "Slide Number Placeholder 0"
With preNum.Designs(i).SlideMaster.Shapes("Slide Number Placeholder 0").TextFrame
.TextRange.InsertAfter (" / " & CStr(preNum.Slides.Count))
.MarginLeft = Round(0.1 / ConvPoinCm, 2)
.MarginRight = Round(0.1 / ConvPoinCm, 2)
.MarginBottom = Round(0.1 / ConvPoinCm, 2)
.MarginTop = Round(0.1 / ConvPoinCm, 2)
.TextRange.Font.Size = 12
.TextRange.Font.Name = "Arial"
.TextRange.ParagraphFormat.Alignment = ppAlignRight
End With
Next i
'(re)création dans chaque DISPOSITION de la zone de pagination avec le nombre total de diapo
For i = 1 To preNum.Designs.Count
For j = 1 To preNum.Designs(i).SlideMaster.CustomLayouts.Count
preNum.Designs(i).SlideMaster.CustomLayouts(j).Shapes.AddPlaceholder(ppPlaceholderSlideNumber, _
0, preNum.PageSetup.SlideHeight - Round(1 / ConvPoinCm, 2), _
Round(1.7 / ConvPoinCm, 2), _
Round(1 / ConvPoinCm, 2)).Name = "Slide Number Placeholder 0"
With preNum.Designs(i).SlideMaster.CustomLayouts(j).Shapes("Slide Number PlaceHolder 0").TextFrame
.TextRange.InsertAfter (" / " & CStr(preNum.Slides.Count))
.MarginLeft = Round(0.1 / ConvPoinCm, 2)
.MarginRight = Round(0.1 / ConvPoinCm, 2)
.MarginBottom = Round(0.1 / ConvPoinCm, 2)
.MarginTop = Round(0.1 / ConvPoinCm, 2)
.TextRange.Font.Size = 12
.TextRange.Font.Name = "Arial"
.TextRange.ParagraphFormat.Alignment = ppAlignRight
End With
Next j
Next i
'homogénéisation et prise en compte du n° de page
For i = 1 To preNum.Slides.Count
If preNum.Slides(i).HeadersFooters.SlideNumber.Visible = False Then _
preNum.Slides(i).HeadersFooters.SlideNumber.Visible = True
Next i
MsgBox "Terminé." & vbCrLf & preNum.Name & " contient " & _
preNum.Slides.Count & " diapositives.", vbInformation
End Sub |
Partager