Discussion :

[Archalia]

Bonjour à tous,

Voilà mon soucis, j'ai actuellement un dossier comprenant au bas mot 150 photos classées par titre de la façon suivante préfixe_2711_600. Ce qui signifie photo prise à l'endroit préfixe le 27/11 à 06h00.Mon souhait serait de réussir à en faire un diaporama d'images successives de façon chronologique et avec au dessus de chaque image un titre mis en forme. Qui donnerait quelque chose comme Préfixe le 27/11 à 6h00.

J'ai trouvé une partie de mon bonheur avec ce tuto à cette adresse: http://argyronet.developpez.com/offi...int/diaporama/

Seulement voilà aussi génial soit-il et bien réalisé, ce tuto n'affiche pas les titres des fichiers ce qui est problématique pour moi. N'y connaissant strictement rien en VBA ni à la structure d'un fichier powerpoint je suis dans l'incapacité totale de modifier moi même ce code.

j'ai des notions de programmation en JAVA et C donc je peux habituellement me débrouiller mais là ça dépasse mes compétences.

Si une âme charitable voulait bien m'aider à résoudre mon problème j'en serai ravi.

En vous remerciant.

Cordialement.

[argyronet]

Bonjour,

Il faut ajouter cette procédure et cette fonction dans le projet :
Pour remplir la zone de titre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub FillTextBoxWithFileName(ByVal FullFileName As String)
Dim oShp                                                    As Shape
 
    ActiveWindow.Selection.SlideRange.Layout = ppLayoutTitleOnly
    For Each oShp In ActiveWindow.Selection.SlideRange.Shapes
        oShp.Select
        If oShp.Type = msoPlaceholder Then
            With ActiveWindow.Selection.TextRange
                .Text = GetFileName(FullFileName)
            End With
        End If
    Next
End Sub

Pour obtenir le nom du fichier :
(tel que tu me l'a décris par MP à savoir préfixe_2711_600, donc à modifier et à adapter selon l'occurence du nom de fichier...)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
 
Private Function GetFileName(ByVal FileName As String) As String
Dim strDate                                                 As String
Dim strTime                                                 As String
Dim I                                                       As Integer
Dim J                                                       As Integer
Dim strFileName                                             As String
    strFileName = Left$(FileName, InStrRev(FileName, ".") - 1)
    I = InStr(1, strFileName, "_")
    strDate = Mid$(strFileName, I + 1, 4)
    Select Case Len(strDate)
        Case 3: strDate = Left$(strDate, 1) & "/" & Mid$(strDate, 2, 2)
        Case 4: strDate = Left$(strDate, 2) & "/" & Mid$(strDate, 3, 2)
    End Select
    J = InStr(I + 1, strFileName, "_")
    strTime = Trim$(Mid$(strFileName, J + 1, 4))
    Select Case Len(strTime)
        Case 3: strTime = Left$(strTime, 1) & "h" & Mid$(strTime, 2, 2)
        Case 4: strTime = Left$(strTime, 2) & "h" & Mid$(strTime, 3, 2)
    End Select
    GetFileName = Left$(strFileName, I - 1) & " le " & strDate & " à " & strTime
End Function

Ensuite, dans la boucle suivante, ajouter l'appel de la procédure :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
   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

Ce qui donne alors :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
    For I = LBound(straFilesName) To UBound(straFilesName)
      strPictureName = strPath & Trim(straFilesName(I))
      AutoFitCurrentPicture strPictureName
      FillTextBoxWithFileName Trim$(straFilesName(I))
      If I < UBound(straFilesName) Then
        ActiveWindow.View.GotoSlide ActivePresentation.Slides.Add(ActivePresentation.Slides.Count, ppLayoutBlank).SlideIndex
      End If
    Next

Note:
Cette solution n'est pas exempt d'erreurs et je te la soumets en vitesse car j'ai écrit ces bouts de code vite fait bien fait (humm...).
Là où tu risques d'avoir des améliorations à apporter, ce sera dans la fonction GetFileName() et aussi dans la mise en forme (Couleur, Police etc...) et la position du titre avec le nom du fichier.

Bon courage,

Argy

[Archalia]

Fantastique, je ne sais comment vous remercier. Il ne me reste plus qu'à réussir à mettre en forme le titre et trouver comment faire pour ne pas qu'il apparaisse sur l'image.

Encore merci