Bonjour à tous,

J'aimerais optimiser le traitements de mes Copils (deux par mois, avec 25 graphiques par copil) qui me prenais beaucoup de temps.
Grâce à ce bout de macro que j'ai adapté, qui me transféré les graphiques d'excel vers PowerPoint.
Je suis passé de deux heures à 15 min.
Et j'aimerais encore m'abstraire de certaines taches manuelles.



Mon Code principal
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
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub GraphExcel_vers_PowerPoint()
   Dim sPPTFileName As String
   Dim ppApp As PowerPoint.Application
   Dim ppPres As PowerPoint.Presentation
   Dim cht As Excel.ChartObject
 
   ' Pour ouvrir dans le dossier en cours
   ChDrive ActiveWorkbook.Path
   ChDir ActiveWorkbook.Path
 
   'Sélectionner le fichier PowerPoint à ouvrir
   sPPTFileName = MonFichierPPt
 
   ' Si pas de dossier choisi ; je sort de la procedure
   If sPPTFileName = "" Then
        Exit Sub
   End If
 
   'Ouvrir PowerPoint
   Set ppApp = CreateObject("PowerPoint.Application")
        ppApp.Visible = msoTrue
   Set ppPres = ppApp.Presentations.Open(sPPTFileName)
        ppApp.ActiveWindow.ViewType = ppViewNormal
 
'*************
'** slide "résumé"
'*************
   'Graphique no1
   Set cht = ThisWorkbook.Sheets("Bilan_Auto").ChartObjects("causes_NON_RO")
   Call ChartsToPPT(ppPres, "slide_resume", cht, 250, 2, 312, 249, "graph_1")
 
   Set cht = Nothing
   Set ppPres = Nothing
   Set ppApp = Nothing
End Sub
Fonction d'ouvertue de PPt avec choix du 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
Function MonFichierPPt() As String
   Dim sFileName As Variant
   Dim sFileFilter As String, sTitle As String
 
   'sFileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file"
   sFileFilter = "PowerPoint Files (*.ppt*; *.potx), *.ppt*"
   sTitle = "Choisir le COPIL de destination"
   sFileName = Application.GetOpenFilename(sFileFilter, , sTitle)
   If sFileName <> False Then
      GetFileName = sFileName
   End If
 
' Verifi que c'est un PPt model ou en cours de correction
NamePpt = Left(Mid(sFileName, InStrRev(sFileName, "\") + 1), 12)
    If NamePpt = "AAAA_MM_MMM_" Then
            NouveauFichier
            'MsgBox "NamePpt (model) = " & NamePpt
        Else
            'MsgBox "NamePpt (EnCours) = " & NamePpt
    End If
 
End Function

fonction pour Enregistré PPt sous un nouveau nom : Qui marche pas...
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
Function NouveauFichierPPt() As String
NameFichier = "taratata"
 
With Application.FileDialog(msoFileDialogSaveAs)
'With Application.ActivePresentation
    '.SaveCopyAs "New Format Copy"
    '.SaveAs "Old Format Copy", ppSaveAsPowerPoint4
        ' Affichage d'un titre particulier dans la boite de dialogue :
        .Title = "Sauve Fichier PPt"
        ' Sélection d'un dossier de base :
        .InitialFileName = NameFichier & ".pptx"
        .FilterIndex = 2
        If .Show Then
            ppApp.SaveAs _
                        Filename:=.SelectedItems(1), _
                        FileFormat:=ppSaveAsDefault
        End If
End With
 
End Function
mon souci principal :
J'arrive pas enregistrer sous un nouveau PPt

fonction pour Enregistré PPt sous un nouveau nom
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
Function NouveauFichierPPt() As String
NameFichier = "taratata"




mon souci secondaire:
j'aimerais déplacer ce bout de code : Mon Code principal
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
Sub GraphExcel_vers_PowerPoint()
   ' Si pas de dossier choisi ; je sort de la procedure
   If sPPTFileName = "" Then
        Exit Sub
   End If
dans celui-là : Fonction d'ouvertue de PPt avec choix du fichier
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Function MonFichierPPt() As String

d'habitude je fais comme ceci, mais j'ai bien ce principe de Fonction (nouveau pour moi ) :

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
Sub OuvreExcel()
    With Application.FileDialog(msoFileDialogFilePicker)
        'Autorise la multi-sélection
        .AllowMultiSelect = False
        'Définit un titre pour la boîte de dialogue
        .Title = "Sélectionnez le Fichier TMP à traiter"
        'Définit une liste de filtres pour le champ "Type de fichiers".
        .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
 
        .InitialFileName = "*TPM*"
        .Show
 
        'On sort si aucun fichier n'a été sélectionné
            If .SelectedItems.Count > 0 Then
                Chemin = .SelectedItems(1)
            Else
                Exit Sub
            End If
   End With
End Sub
Merci beaucoup de votre Aide