Discussion :

[JojoSs]

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

[JojoSs]

Bonjour à tous,

Voici quelques compléments sur mon problème d’enregistrement.
Je ne suis pas très à l'aise sur les macros, mais pas obligation j'arrive à en faire.

Mon contexte :
J'ai deux fichiers "model" : un Excel et un PowerPoint, avec comme racine du Nom de Fichier "AAAA-MM-MMM".
Lors de mon traitement Mensuel, j'aimerais que ses deux fichiers soit renommés mais que je puisse choisir aussi leurs Nom via une fenêtre.
sous Excel, j'ai aucun souci, ça marche très bien
mais avec PowerPoint je tourne en rond...


là ou je tourne en rond, c'est d'enregistrer (avec une boite de dialogue) un PowerPoint (avec macro) vers un autre PowerPoint (nouveau nom et sans macro) via Excel (qui est mon fichier principal et de commande...)

Mais avec se code, ce sont des extensions d'excel qui sont proposées

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
Function NouveauFichierPPt() As String
NameFichier = "taratata"
    With Application.FileDialog(msoFileDialogSaveAs)
        .Title = "Sauve Fichier PPt"
        .InitialFileName = NameFichier & ".pptx"
        .FilterIndex = 2
            If .Show Then
                ppApp.SaveAs _
                                Filename:=.SelectedItems(1), _
                                FileFormat:=ppSaveAsDefault
            End If
    End With
End Function

J'aimerais utiliser des fonctions dans mon code. d'ou me question initial de l'ameliorer (c'est un code existant depuis un na, mais avec beaucoup d'action manuelle.
reste a voir lequelle serais le mieux des deux :

• Application.GetOpenFilename()
• With Application.FileDialog()

il me semble que (Application.FileDialog()) et plus simple pour définir plus d'options

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
Function MonFichierPPt() As String
   Dim sFileName As Variant
   Dim sFileFilter As String, sTitle As String
 
   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
End Function

J'ai rajouter ce code afin de vérifier le type de fichier et pour exécuter des actions différentes suivant que c'est un premier traitement ou une correction.
et qui marche bien sauf pour la suite...

Code :

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

1
2
3
4
5
6
7
8
' 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
            'MsgBox "NamePpt (model) = " & NamePpt
            ppPres.SaveAs Filename:=dossierpp, FileFormat:=ppSaveAsDefault
        Else
            'MsgBox "NamePpt (EnCours) = " & NamePpt
    End If

[Marc-L]

Bonjour,

pour rappel :

Important : Éditorial - à lire avant de poster