Réaliser un complément PowerPoint pour générer un diaporama à partir d'un dossier

Jean-Philippe AMBROSINO

Ce document a pour but de vous montrer comment, avec Visual Basic for Application, concevoir un complément PowerPoint pour générer un diaporama à partir d'un dossier contenant des images.

Bien qu'il existe une fonctionnalité similaire, mais loin d'être aussi simpliste dans les versions ultérieures à la version 2000, ce tutoriel vous apporte entre autres une connaissance et une approche qui n'est pas souvent évoquée sur les forums. Commentez ♪

- Titre : Réaliser un complément PowerPoint pour générer un diaporama à partir d'un dossier

- Auteur : Jean-Philippe AMBROSINO

- Parution : 10 septembre 2006

- Mise à jour : 13 septembre 2006

- Licence : Ce document est issu de http://www.developpez.com et reste la propriété exclusive de son auteur. La copie, modification et/ou distribution par quelque moyen que ce soit est soumise à l'obtention préalable de l'autorisation de l'auteur.

Sommaire

- 1. Avant-propos

- 1-1. Remerciements

- 1-2. Contact

- 2. Présentation du projet

- 2-1. Utilisation

- 2-2. Fin de génération

- 2-3. Chargement et déchargement du complément

- 3. Code VBA du projet

- 3-1. Le module de gestion des diapositives

- 3-2. Le module de gestion des dossiers et des fichiers

- 3-3. Le formulaire UserForm

- 4. Comment cela fonctionne-t-il ?

- 5. Création du complément

- 5-1. Sauvegarde du projet

- 5-2. Les tests

- 5-3. La génération du complément

- 6. Conclusion

1 - Avant-propos

Ce document a pour but de vous montrer comment, avec Visual Basic for Application, concevoir un complément PowerPoint pour générer un diaporama à partir d'un dossier contenant des images.
Bien qu'il existe une fonctionnalité similaire, mais loin d'être aussi simpliste dans les versions ultérieures à la version 2000, ce tutoriel vous apporte entre autres une connaissance et une approche qui n'est pas souvent évoquée sur les forums.

Le résultat final vous donnera la possibilité de sauvegarder ou non votre fichier PPS prêt à l'emploi.

1-1 - Remerciements

Je tiens à remercier tout particulièrement toutes celles et tous ceux qui ont participé à la relecture de ce document en y incluant leurs remarques.

1-2 - Contact

Pour tout renseignement complémentaire, veuillez me contacter directement (Argyronet) par MP.

2 - Présentation du projet

Le projet n'est au départ qu'une simple nouvelle présentation vierge et dépourvue de toute diapositive.
Le principe de réalisation consiste à attaquer directement le code VBA depuis l'interface de développement Visaul Basic Editor (VBE).

Le projet se compose de deux Modules et d'un objet UserForm (facultatif)

Chargement du projet

Lorsque vous lancez PowerPoint en vue de créer une présentation quelconque, si peu que n'ayez pas coché la case appropriée, ce message apparaît à chaque fois.

Il indique que le complément « DiaporamaCreator » est chargé et que vous disposez de la fonction « Créer un diaporama… » dans le menu Insertion.

Ce message est représenté par un objet UserForm que vous allez créer ci-après.

La case à cocher permet de ne plus voir ce message au démarrage de PowerPoint.
Du fait que la mise en place de ce formulaire est facultative, je vous laisse le soin de choisir également si vous souhaitez ou non inclure ce contrôle et le code qui l'accompagne.

Mode de fonctionnement

C'est à partir du menu Insertion que la génération s'effectue.

Rien ne vous empêche de réaliser votre propre menu ou bien de faire en sorte que cette rubrique soit située dans un autre menu.

Les diapositives

Par défaut, le code fait en sorte que chaque diapositive est mise en forme avec un dégradé noir centré qu'il convient de modifier à votre guise si ce rendu ne vous convenait pas.
Le choix de cette palette est établi sur le fait qu'elle s'adapte à tout type de photographie.

Pour ce faire, vous pourrez toujours utiliser l'enregistreur de macros, récupérer le code pour l'adapter ou le substituer à l'existant.

2-1 - Utilisation

Lorsque vous êtes prêt à générer le diaporama, le projet vous demande quel intervalle en secondes il faut définir entre chaque diapositive.
En effet, l'ensemble du diaporama est régi par la même transition de fondu par le noir avec un intervalle défini par défaut à 5 secondes.

Encore une fois, il vous appartient de modifier le code source pour mettre en œuvre des transitions aléatoires selon vos préférences.

Par la suite, un message vous demande si vous souhaitez utiliser la présentation en cours ou bien si vous souhaitez en générer une nouvelle.
En effet, en choisissant la présentation active, vous cumulerez les images au fur et à mesure que vous sélectionnerez un nouveau dossier.

Dans le cas contraire, le programme ajoute une nouvelle présentation vierge avant d'y insérer les images.

Types de fichiers

Pour pouvoir insérer l'ensemble des images dans chaque diapositive, vous devez sélectionner un dossier contenant des images.
Les formats supportés sont dans cet exemple au nombre de quatre à savoir :

- JPG

- GIF

- BMP

- EMF

Mais vous pouvez ajouter aux constantes représentant ces extensions, toutes celles supportées par PowerPoint.

Const JPG As String = "jpg"
Const BMP As String = "bmp"
Const WMF As String = "wmf"
Const EMF As String = "emf"

Sélection du dossier

Pour afficher la liste des dossiers, j'ai choisi d'utiliser l'API SHBrowseForFolder() qui affiche cette boite de dialogue, invitant l'utilisateur à sélectionner le dossier souhaité…

Pour un confort d'utilisation , j'ai implémenté une procédure permettant de faire en sorte que la liste des dossiers se cale sur le dernier dossier sélectionné.
Par ailleurs, le chemin de ce dossier est stocké dans la base de Registre de Windows.

J'ai intentionnellement – et parce que ce forum regorge de code source pour le faire de façon plus personnelle – exploité la clé dédiée aux applications Visual Basic à savoir :

HKEY_CURRENT_USER\Software\VB and VBA Program Settings\

où seront créées les valeurs respectivement nommées LastPathUsed pour définir le dernier dossier utilisé et DoNotShowAtStartup pour laisser afficher l'invite du projet, le tout, à partir de la sous-clé Settings.

2-2 - Fin de génération

Lorsque vous avez sélectionné le dossier, aussitôt après, le processus de génération commence pour, quelques secondes plus tard^1 , afficher ce message :

1) - Le temps de réalisation du diaporama dépend à la fois de l'ordinateur sur lequel est exécuté ce projet et aussi du nombre d'images contenu dans le dossier. J'avais envisagé de greffer une barre de progression, mais je vous laisse le choix d'ajouter ce petit plus finalement superflu…

Sélection du dossier

Par défaut, la présentation nouvellement créée est nommée « Diaporama No jmyyyy hhmmss.pps » où jmyyyy représente, vous l'avez deviné, la date du jour et hhmmss l'heure de génération.
Là aussi, c'est à vous de coder le processus pour que le nom des fichiers générés porte celui que vous souhaitez.

Que vous répondiez Oui ou Non pour la sauvegarde du fichier, le diaporama s'exécute aussitôt après.
De là, après avoir appuyé sur Echap pour interrompre le cycle, vous pouvez agir comme sur une simple présentation à savoir :

- Modifier les transitions

- Donner des effets d'animation

- Supprimer des diapositives

- …

Toutefois, l'objectif de ce tutoriel se borne à vous montrer le côté pratique de ce complément qui se limite à la génération d'un 'diaporama minute'.

Au sein du code VBA, vous verrez notamment :

- Comment créer un complément

- Comment charger et décharger ce complément

- Comment insérer un élément de menu dans un menu existant qui se supprime lorsque le complément est déchargé.

- Comment exploiter les fonctions SaveSetting() et GetSetting()

- Comment exploiter l'API SHBrowseForFolder avec option d'ouverture sur un dossier cible…

2-3 - Chargement et déchargement du complément

Pour charger le complément, une fois que vous l'avez développé bien entendu et que vous l'avez compilé, vous pouvez le charger ou le décharger depuis le menu Outils/Macros complémentaires…

Cette boite de dialogue apparaît, vide si aucun complément n'a déjà été chargé ;
là, il vous faut cliquer sur Nouvelle (sous-entendu nouvelle macro complémentaire) pour qu'apparaisse la boite de dialogue permettant de sélectionner le ou les compléments concernés.

Notez ici que le chemin par défaut des compléments créés est défini comme suit :

C:\Documents and Settings\Argyronet\Application Data\Microsoft\Macros complémentaires

où, ici, l'utilisateur en cours est Argyronet (c'est moi !!! )

Il vous appartient de faire en sorte que ce dernier soit stocké dans un dossier où tous les utilisateurs y aient accès si toutefois vous souhaitez faire en sorte que ce complément soit disponible, quelle que soit la session chargée.

Dans ce cas précis ci-avant, seul Argyronet peut utiliser ce complément.

Une fois que vous avez cliqué sur OK, le message d'alerte d'activation des macros se fait suivre et vous invite à choisir si vous voulez ou non activer les macros de ce complément.

Ce message n'apparaît pas du tout si le niveau de sécurité est défini à Bas (non recommandé) et charge le complément ou si votre projet est signé numériquement.

Donc, réglez la sécurité sur Moyen de manière à ce que ce message s'affiche systématiquement.

Vous cliquez alors sur Activer les macros derrière quoi, cette fenêtre apparaît selon les modalités expliquées ici…

La fenêtre de la liste des compléments reste affichée :

- le complément que vous avez sélectionné se voit alors précédé d'une croix pour signifier qu'il est chargé ;

- la croix disparaît lorsqu'il est déchargé.

Cliquez alors sur Fermer et choisissez Créer un diaporama depuis le menu Insertion.

La procédure CloseAddinsPopup() ferme par API la fenêtre des compléments dès que vous avez appuyé sur OK sur la fenêtre de bienvenue.

3 - Code VBA du projet

Le code VBA du projet nécessite un certain degré de connaissance en matière de développement.

Il est vrai qu'il n'est pas commenté (je commente très peu mon code en général) du fait que la lisibilité associée au nom des objets et procédures est suffisamment explicite pour un développeur habitué au VB ou au VBA.

3-1 - Le module de gestion des diapositives

C'est le module qui contient l'ensemble du code qui gère les images à savoir :

- l'insertion de nouvelles diapos en fonction du nombre d'images du dossier ;

- leur sélection et leur mise en place dans les diapositives en les ajustant.

Le tout cerné par l'ensemble des routines

- d'appels de sélection de dossier ;

- de confirmation d'utilisation de la présentation en cours ;

- du délai à définir pour le diaporama ;

- de l'enregistrement de la présentation ;

- …

Module basPictures

Option Explicit

Public Const APP_NAME As String = "DiaporamaCreator"
Public Const KEY_SETTINGS As String = "Settings"
Public Const VALUE_LASTPATHUSED As String = "LastPathUsed"
Public Const VALUE_DONOTSHOWATSTARTUP As String = "DoNotShowAtStartup"
Public Const MENU_NAME As String = "Insert"
Public Const MENU_NAME_FR As String = "Insertion"
Public Const ICON_CAPTION As String = "Créer un diaporama..."

Private Const ACTION_TO_DO As String = "InsertAutoFitPicturesIntoSlides"
Private Const TOOL_TIP_TEXT As String = "Génération d´un diaporama"
Private Const ICON_DESCRIPTION As String = "insère des photos ajustées pour la génération d´un diaporama"
Private Const ICON_TAG As String = "TAG_InsertAutoFitPictureIntoSlides"

Private Const THIS_PRESENTATION_PPT As String = "DiaporamaCreator.ppt"
Private Const THIS_PRESENTATION_PPA As String = "DiaporamaCreator.ppa"

Sub Auto_Open()
Dim oBar As CommandBar
Dim oControl As CommandBarControl
Dim oCBMenu As CommandBars
Dim blnFound As Boolean
Dim blnValue As Boolean
Dim I As Integer

On Error Resume Next
Set oCBMenu = Application.CommandBars
For Each oControl In oCBMenu(MENU_NAME).Controls
If oControl.Tag = ICON_TAG Then
blnFound = True
Exit For
End If
Next oControl

If blnFound = False Then
On Error Resume Next
Set oControl = CommandBars(MENU_NAME).Controls.Add(msoControlButton)
With oControl
.BeginGroup = msoTrue
.FaceId = 1362
.OnAction = ACTION_TO_DO
.TooltipText = TOOL_TIP_TEXT
.Caption = ICON_CAPTION
.DescriptionText = ICON_DESCRIPTION
.Visible = msoTrue
.Style = msoButtonCaption
.Tag = ICON_TAG
End With
End If

Set oControl = Nothing

blnValue = CBool(GetSetting(APP_NAME, KEY_SETTINGS, VALUE_DONOTSHOWATSTARTUP))
If blnValue = False Then frmWelcome.Show
On Error GoTo 0
DoEvents
CloseAddinsPopup
End Sub

Sub Auto_Close()
Dim oBar As CommandBar
Dim oControl As CommandBarControl
Dim oCBMenu As CommandBars

On Error Resume Next
Set oCBMenu = Application.CommandBars
For Each oControl In oCBMenu(MENU_NAME).Controls
If oControl.Tag = ICON_TAG Then
oControl.Delete
End If
Next oControl
Set oCBMenu = Nothing
End Sub

Sub InsertAutoFitPicturesIntoSlides()
Dim straFilesName() As String
Dim strFilesName As String
Dim strPictureName As String
Dim strPath As String
Dim strDelay As String
Dim strFileName As String
Dim strLastFolderUsed As String
Dim I As Integer

If Presentations.Count <> 0 Then
If ActivePresentation.Name <> THIS_PRESENTATION_PPT And ActivePresentation.Name <> THIS_PRESENTATION_PPA Then
If MsgBox("Voulez-vous utiliser la présentation active (" & ActivePresentation.Name & ") pour insérer les photos ?", _
36, "Utiliser la présentation") = 6 Then
If ActiveWindow.ViewType <> ppViewSlideSorter Then
ActiveWindow.ViewType = ppViewSlideSorter
End If
Else
CreateNewPresentation
End If
Else
CreateNewPresentation
End If
Else
CreateNewPresentation
End If

ActiveWindow.ViewType = ppViewSlide
strDelay = InputBox("Combien de secondes entre chaque photo ?", "Durée du cycle", "5")
If Len(strDelay) Then
If IsNumeric(strDelay) = msoFalse Then
Exit Sub
End If
Else
Exit Sub
End If

strLastFolderUsed = GetSetting(APP_NAME, KEY_SETTINGS, VALUE_LASTPATHUSED)
If Len(strLastFolderUsed) = 0 Then
strLastFolderUsed = Left(ActivePresentation.Path, 3)
End If
strPath = GetPicturesFolder(strLastFolderUsed)
strLastFolderUsed = strPath
strFilesName = GetFileString(strPath)

If Len(strFilesName) = 0 Then
MsgBox "Exécution annulée par l´utilisateur !", 48, "Fin"
Exit Sub
Else
straFilesName = Split(strFilesName, SEPARATOR)
End If

For I = LBound(straFilesName) To UBound(straFilesName)
strPictureName = strPath & Trim(straFilesName(I))
AutoFitCurrentPicture strPictureName
If I < UBound(straFilesName) Then
ActiveWindow.View.GotoSlide ActivePresentation.Slides.Add(ActivePresentation.Slides.Count, ppLayoutBlank).SlideIndex
End If
Next

If MsgBox("Le diaporama est maintenant créé..." & vbCrLf & vbCrLf & "Voulez-vous l´enregistrer ?" & vbCrLf & _
vbCrLf & "Note : Le dossier cible sera" & vbCrLf & strPath, 36, "Enregistrer la présentation") = 6 Then
strFileName = "Diaporama No " & Format(Now, "dmyyyy hhmmss")
ActivePresentation.SaveAs strPath & strFileName, ppSaveAsShow, msoFalse
End If

ShowDiaporama CInt(strDelay)

With ActivePresentation.SlideShowSettings
.Run
End With
End Sub

Private Sub SetSlideBackground()
If ActivePresentation.HasTitleMaster Then
With ActivePresentation.TitleMaster.Background
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = ppTitle
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientFromTitle, 2, 0.89
End With
End If
With ActivePresentation.SlideMaster.Background
.Fill.Visible = msoTrue
.Fill.ForeColor.SchemeColor = ppTitle
.Fill.Transparency = 0#
.Fill.OneColorGradient msoGradientFromTitle, 2, 0.89
End With
With ActivePresentation.Slides.Range
.FollowMasterBackground = msoTrue
.DisplayMasterShapes = msoTrue
End With
End Sub

Private Sub AutoFitCurrentPicture(ByVal FileName As String)
Dim oShape As ShapeRange
Dim sngPictureWidth As Single
Dim sngPictureHeight As Single
Dim sngSlideWidth As Single
Dim sngSlideHeight As Single
Dim sngScaleValue As Single

ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName, msoFalse, msoTrue, 0, 0).Select
Set oShape = ActiveWindow.Selection.ShapeRange

sngPictureWidth = oShape.Width
sngPictureHeight = oShape.Height
sngSlideWidth = ActivePresentation.PageSetup.SlideWidth
sngSlideHeight = ActivePresentation.PageSetup.SlideHeight

If sngPictureWidth > sngPictureHeight Then
sngScaleValue = sngSlideWidth / sngPictureWidth
Else
sngScaleValue = sngSlideHeight / sngPictureHeight
End If
sngScaleValue = sngScaleValue - 0.16

oShape.ScaleHeight CSng(sngScaleValue), msoTrue
oShape.ScaleWidth CSng(sngScaleValue), msoTrue

With ActivePresentation.PageSetup
oShape.Left = (.SlideWidth \ 2) - (oShape.Width \ 2)
oShape.Top = (.SlideHeight \ 2) - (oShape.Height \ 2)
oShape.Select
End With
End Sub

Private Sub CreateNewPresentation()
Presentations.Add msoTrue
ActiveWindow.View.GotoSlide ActivePresentation.Slides.Add(1, ppLayoutBlank).SlideIndex
SetSlideBackground
End Sub

Private Sub ShowDiaporama(ByVal Delay As Integer)

ActiveWindow.ViewType = ppViewSlideSorter
ActivePresentation.Slides.Range.Select
With ActivePresentation.Slides.Range.SlideShowTransition
.EntryEffect = ppEffectFade
.Speed = ppTransitionSpeedSlow
.AdvanceOnClick = msoTrue
.AdvanceOnTime = msoTrue
.AdvanceTime = Delay
.SoundEffect.Type = ppSoundNone
End With
With ActivePresentation.SlideShowSettings
.ShowType = ppShowTypeSpeaker
.LoopUntilStopped = msoTrue
.ShowWithNarration = msoTrue
.ShowWithAnimation = msoTrue
.RangeType = ppShowAll
.AdvanceMode = ppSlideShowUseSlideTimings
.PointerColor.SchemeColor = ppForeground
End With
End Sub

- La procédure Auto_Open() : S'exécute au démarrage du complément et créé le menu.

- La procédure Auto_Close() : S'exécute au déchargement du complément et supprime le menu.

- La procédure InsertAutoFitPicturesIntoSlides() : Procédure globale du projet qui gère la mise en place des images dans chaque diapositive.

- La procédure SetSlideBackground() : Crée un arrière-plan sur chaque diapositive.

- La procédure AutoFitCurrentPicture() : Ajuste l'objet picture au sein de la diapositive en cours.

- La procédure CreateNewPresentation() : Créé une nouvelle présentation vierge.

- La procédure ShowDiaporama() : Configure les paramètres du diaporama et l'exécute en bouche jusqu'à Echap.

3-2 - Le module de gestion des dossiers et des fichiers

Ce module contient l'ensemble des API's nécessaires au projet associé aux fonctions qui s'occupent de fournir le nom du dossier des images et celles permettant la construction de la chaîne contenant les fichiers.

Module basFiles

Option Explicit

Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXPLORER As Long = &H80000

Private Const BIF_STATUSTEXT  As Long = &H4&
Private Const BIF_RETURNONLYFSDIRS  As Long = 1
Private Const BIF_DONTGOBELOWDOMAIN  As Long = 2
Private Const MAX_PATH  As Long = 260

Private Const WM_USER  As Long = &H400
Private Const BFFM_INITIALIZED  As Long = 1
Private Const BFFM_SELCHANGED  As Long = 2
Private Const BFFM_SETSTATUSTEXT  As Long = (WM_USER + 100)
Private Const BFFM_SETSELECTION  As Long = (WM_USER + 102)

Public Const SEPARATOR As String = "|"

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam _
As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As _
BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal _
pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias _
"lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As _
Long

Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd _
As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As _
String) As Long
Private Declare Function PostMessage Lib "user32" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam _
As Long, lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias _
"GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private Const WM_CLOSE = &H10
Private Const ADDIN_POPUP_CLASSNAME As String = "#32770"
Private Const ADDIN_POPUP_TITLE As String = "Macros complémentaires"

Private Type BROWSEINFO
hwndOwner      As Long
pidlRoot       As Long
pszDisplayName As Long
lpszTitle      As Long
ulFlags        As Long
lpfnCallback   As Long
lParam         As Long
iImage         As Long
End Type

Private m_strDirectory As String

Public Sub CloseAddinsPopup()
Dim lngHWnd As Long

lngHWnd = FindWindow(ADDIN_POPUP_CLASSNAME, ADDIN_POPUP_TITLE)
Call SetForegroundWindow(lngHWnd)
If lngHWnd Then
PostMessage lngHWnd, WM_CLOSE, 0&, 0&
End If
End Sub

Public Function GetPicturesFolder(ByVal StartPath As String) As String
Dim strFolder As String
strFolder = BrowseForFolder(StartPath)
If Len(strFolder) Then
SaveSetting APP_NAME, KEY_SETTINGS, VALUE_LASTPATHUSED, strFolder
strFolder = AddDirSep(strFolder)
End If
GetPicturesFolder = strFolder
End Function

Private Function StripNullChar(ByVal Buffer As String) As String
Dim intPosition As Integer
intPosition = InStr(Buffer, vbNullChar)
If intPosition > 0 Then
StripNullChar = Left(Buffer, intPosition - 1)
Else
StripNullChar = Buffer
End If
End Function

Private Function AddDirSep(strPathName As String)
If Right(Trim(strPathName), Len("\")) <> "\" And _
Right(Trim(strPathName), Len("\")) <> "\" Then
strPathName = RTrim$(strPathName) & "\"
End If
AddDirSep = strPathName
End Function

Public Function GetFileString(ByVal Path As String) As String
Dim oFSO As Object ' As Scripting.FileSystemObject
Dim oFld As Object ' As Scripting.Folder
Dim oFile As Object ' As Scripting.File
Dim strFilesName As String
Dim strFilePath As String
Dim strType As String
Dim I As Integer

Const JPG As String = "jpg"
Const BMP As String = "bmp"
Const WMF As String = "wmf"
Const EMF As String = "emf"

Set oFSO = CreateObject("Scripting.FileSystemObject")
'    Set oFSO = New FileSystemObject
Set oFld = oFSO.GetFolder(AddDirSep(Path))
For Each oFile In oFld.Files
strType = Mid(oFile.Name, InStrRev(oFile.Name, ".") + 1)
Select Case LCase(strType)
Case JPG, BMP, WMF, EMF
strFilesName = strFilesName & oFile.Name & SEPARATOR
Case Else
End Select
Next
If Len(strFilesName) Then
GetFileString = Left(strFilesName, Len(strFilesName) - 1)
End If
Set oFld = Nothing
Set oFile = Nothing
Set oFSO = Nothing
End Function

Public Function BrowseForFolder(StartDir As String) As String
Dim lngReturn As Long
Dim strBuffer As String
Dim udtBrowseInfo As BROWSEINFO

m_strDirectory = StartDir & vbNullChar

With udtBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat("Sélection d´un dossier contenant des photos...", " ")
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfnCallback = GetAddressOfFunction(AddressOf BrowseCallbackProc)
End With

lngReturn = SHBrowseForFolder(udtBrowseInfo)
If (lngReturn) Then
strBuffer = Space(MAX_PATH)
SHGetPathFromIDList lngReturn, strBuffer
CoTaskMemFree lngReturn
strBuffer = StripNullChar(strBuffer)
BrowseForFolder = strBuffer
Else
BrowseForFolder = vbNullString
End If

End Function

Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMessage As Long, ByVal lpIDList As Long, _
ByVal pData As Long) As Long
Dim lngRet As Long
Dim strBuffer As String

On Error Resume Next
Select Case uMessage
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTION, 1, m_strDirectory)
Case BFFM_SELCHANGED
strBuffer = Space(MAX_PATH)
lngRet = SHGetPathFromIDList(lpIDList, strBuffer)
If lngRet = 1 Then
Call SendMessage(hwnd, BFFM_SETSTATUSTEXT, 0, strBuffer)
End If
End Select
BrowseCallbackProc = 0
End Function

Private Function GetAddressOfFunction(P As Long) As Long
GetAddressOfFunction = P
End Function

- La procédure CloseAddinsPopup() : ferme la boite de dialogue « Macros complémentaires » une fois que vous cliquez sur OK du UserForm.

- La fonction GetPicturesFolder() : retourne le nom du dossier sélectionné et l'inscrit dans le Registre.

- La procédure StripNullChar() : supprime les caractères vbNullChar « Chr(0) » d'une chaîne passée en paramètre.

- La fonction AddDirSep() : ajoute le séparateur de fichier.

- La fonction GetFileString() : retourne la chaîne complète de l'ensemble des fichiers images du dossier, séparés par le séparateur (Constante SEPARATOR) qui sera traitée comme un tableau avec la fonction Split().

- La fonction BrowseForFolder() : affiche la boite de dialogue de sélection des dossiers.

- La fonction BrowseCallbackProc() : initialise l'élément typé lpfnCallback de la variable udtBrowseInfo : cette initialisation est facultative, mais permet d'afficher cette fenêtre sur le dernier dossier sélectionné (StartDir).

- La fonction GetAddressOf : retourne l'adresse de la fonction (Attention ceci n'est pas supporté par Office 97)

L'usage des variables associées à Scripting.FileSystemObject est déclaré en Objet de façon volontaire afin d'éviter la référence à scrrun.dll. Mais rien ne vous empêche de cocher la référence et ainsi bénéficier de l'intellisence pour compléter par exemple le code.

L'affectation de la variable oFSO se fait alors avec un CreateObject().

3-3 - Le formulaire UserForm

Pour concevoir le UserForm, insérer un nouvel objet UserForm dans votre projet et insérez-y :

- un contrôle Image contenant l'icône vbInformation ;

- un contrôle Label nommé lblMessage dont la légende est # signifiant (pour moi) que celui-ci est alimenté dynamiquement ;

- un contrôle CheckBox intitulé chkDontShow ;

- un contrôle bouton de commande intitulé cmdOK.

Vous nommerez cet objet frmWelcome.
- Il n'y a pas de propriétés particulières à définir ici si ce n'est le titre qui est « Créer un diaporama ».
- Vous les disposez de telle sorte à ce que vous obteniez quelque chose ressemblant à l'illustration ci-dessous.

Le label devant contenir le message à afficher contient un caractère #.

En effet, c'est sur l'événement UserForm_Activate() que s'initialise ce message.
Ce message est stocké provisoirement dans une variable de type String où sont appelées les valeurs des constantes du nom du menu (MENU_NAME_FR) et le nom de la rubrique (ICON_CAPTION).

Code du UserForm frmWelcome

Option Explicit

Private Sub chkDontShow_Click()
SavePreferences chkDontShow.Value
End Sub

Private Sub cmdOK_Click()
SavePreferences chkDontShow.Value
Unload Me
End Sub

Private Sub UserForm_Activate()
Dim strMessage As String

strMessage = "Vous êtes prêt(e) à créer un diaporama à partir des photos que vous allez sélectionner..." & _
vbCrLf & vbCrLf & "Dans le menu [" & MENU_NAME_FR & "], choisissez la rubrique [" & _
ICON_CAPTION & "]."
lblMessage.Caption = strMessage
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = (CloseMode = vbFormControlMenu)
End Sub

Private Sub SavePreferences(ByVal ShowAtStartup As Boolean)
SaveSetting APP_NAME, KEY_SETTINGS, VALUE_DONOTSHOWATSTARTUP, ShowAtStartup
End Sub

- L'événement chkDontShow_Click : Evénement Click qui appelle la procédure SavePreferences.

- L'événement cmdOK_Click : Evénement Click qui appelle la procédure SavePreferences puis décharge le UserForm.

- L'événement UserForm_Activate : Initialise le contenu du Label lblMessage.

- L'événement UserForm_QueryClose : Empêche la fermeture de la fenêtre par la croix en initialisant Cancel selon le paramètre CloseMode.

- La procédure SavePreferences : Procédure écrivant la valeur dans la base de Registre.

4 - Comment cela fonctionne-t-il ?

1 - Le principe est relativement simple :

L'ouverture de l'application entraîne l'exécution de la procédure Auto_Open() qui installe le menu puis affiche un message de bienvenue.
Lorsque l'utilisateur charge le complément depuis la liste des macros complémentaires (à faire une seule et unique fois) le même phénomène se produit.

2 - Déroulement :

Lorsque l'utilisateur clique sur le menu pour créer son diaporama, le programme vérifie d'abord s'il y a une présentation active autre
que celle du projet, bien entendu.
La question lui est alors posée, le cas échéant, de savoir s'il veut ou non l'utiliser s'il y en a une.
Cela permet en fait d'enrichir la présentation de photos à partir de dossiers différents.

=> Dans tout autre cas, une nouvelle présentation est créée.

La question du délai à définir entre chaque diapo est alors posée puis la sélection du dossier s'en suit aussitôt après…

3 - Sélection du dossier :

Le programme ensuite appelle l'ouverture de la boite de dialogue des dossiers par le biais de la fonction BrowseForFolder(), mais
vérifie dans le Registre si un dossier a déjà été sélectionné auquel cas il affiche ladite boite sur ce dernier.

Aussitôt après, le nom du dossier est exploité par la fonction GetFileString() qui alimente la variable strFilesName.
Cette variable va contenir une chaîne de l'ensemble des fichiers du dossier séparés par un séparateur déclaré en constante.

4 - Construction de la présentation :

Une boucle s'établit alors avec l'exploitation des bornes d'un tableau de Strings retourné par la fonction Split() :

Pour chaque élément du tableau, une variable s'initialise avec le nom du dossier suivi du nom du fichier dans l'index de la boucle et appelle
la procédure AutoFitCurrentPicture() pour y loger l'image.

4 - Visualisation :

Lorsque la boucle a terminé son cycle, un message apparaît pour en informer l'utilisateur et pose la question de l'enregistrement
de cette dernière.

Le diaporama est alors lancé, quelle que soit la réponse.

5 - Création du complément

La dernière étape consiste à générer le complément.

5-1 - Sauvegarde du projet

- Commencez par enregistrer votre projet au format Présentation PowerPoint (PPT) sous un nom explicite de manière à garder une source modifiable.

- Une fois cela fait, testez votre projet en appuyant sur F5 dans la procédure Auto_Open().

5-2 - Les tests

- Réduisez l'éditeur VBE.

- Sélectionnez dans le menu Insertion la rubrique Créer un diaporama: la procédure doit s'exécuter aussitôt.

- Sélectionnez un dossier contenant des images aux formats appropriés.

- C'est tout…

5-3 - La génération du complément

Une fois que vos tests sont concluants, enregistrez votre projet au format Macro complémentaire PowerPoint (PPA).

C'est terminé.

6 - Conclusion

Ce tutoriel va vous permettre de connaître l'étendue de quelques possibilités intéressantes réalisables avec PowerPoint.
Il est évident que cette application n'est pas vouée à être exploitée en tant que telle comme les autres applications Office, mais, il peut être intéressant de connaître et mettre en place ce genre de processus pour par exemple, faire une présentation instantanée par programme depuis une autre application.

Les possibilités sont relativement vastes compte tenu du fait que ce sont les idées qui vous permettront d'exploiter ce tutoriel.
Si vous rencontrez des difficultés ou si j'ai omis de préciser quelque chose qui reste obscur, n'hésitez pas à m'en faire part.