Présentation du projet
 | Rien de 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. |
2-1. Utilisation
Const JPG As String = "jpg"
Const BMP As String = "bmp"
Const WMF As String = "wmf"
Const EMF As String = "emf" |
HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ |
2-2. Fin de génération
 | 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... |
- 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
C:\Documents and Settings\Argyronet\Application Data\Microsoft\Macros complémentaires |
)
 | 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 soit suffisament explicite pour un développeur habitué au VB ou au VBA.
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 soit suffisament 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 nouvelle 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 photos ?", "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éé 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 boîte 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 boîte 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 de pouvoir 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 sont déclarées 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.
- 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ée 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.
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...
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 boîte 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 la dite boîte 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.
Le programme ensuite appelle l'ouverture de la boîte 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 la dite boîte 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.
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.
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é.
C'est terminé.
6. Conclusion
Ce tutoriel va vous permettre de connaître l'étendue de quelques possibilté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 possibilté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.
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 possibilté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.
آخر مواضيع منتدى نقاش المغرب العربي
Aucun commentaire:
Enregistrer un commentaire