VBA Insérer graphiques dans fichiers ppt et doc avec modèles

Bonjour à tous,

Bon, presque tout est dans le titre; en gros, mon programme va chercher des données et préparer des graphs, que pour le moment je met dans une nouvelle feuille excel.

Mais je voudrais les insérer dans un nouveau fichier word ou powerpoint (ppt de préférence mais j'aimerais pouvoir choisir avec une petite boîte de dialogue où l'on peut cocher), mais le top ça serait de pouvoir ouvrir un fichier modèle (présent dans le dossier si nécessaire) et insérer les graphiques (et du texte) directement dedans!

L'extrait du code concernant le graphique! :

Set gr = ActiveWorkbook.Charts.Add
                With gr
                .SetSourceData Source:=Range(Sheets("TTF").Cells(m + 2 * j + 5, 17), Sheets("TTF").Cells(m + 2 * j + 6, 16 + n + j)), PlotBy:=xlRows
                .ChartType = xlXYScatterSmooth
                .Location Where:=xlLocationAsNewSheet
                .HasTitle = True
                .ChartTitle.Characters.Text = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(m + j, 13)
                .SeriesCollection(1).Name = Sheets("Feuille Codes").Cells(i, 6)
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "TTF"
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nb"
                .PlotArea.Interior.ColorIndex = 2
                .Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
                .ChartArea.Font.Size = 14
                .Deselect
                End With

Donc j'aurais besoin du code pour ouvrir un modèle avec powerpoint et word et comment y insérer les graphs et quelques commentaires (annotations ou autres) si possible.

Et si il y a quelqu'un qui sait comment faire une petite interface dans laquelle on coche, ça m'intéresse aussi (sinon, je ferais ça à l'ancienne avec une inputbox)

Merci d'avance!

-- 01 Aoû 2011, 19:53 --

Petit up, ça m'aiderait bien!

Merci d'avance!

Salut le forum

Une petite recherche sur le forum et ... Insérer données Excel dans PowerPoint

Mytå

Bonsoir Mytå,

Merci de ta réponse mais j'avais déjà fouiné et essayé cette possibilité mais j'aimerais utiliser un modèle lors de l'ouverture parce que les fichiers serviront souvent.

Et en fouillant ailleurs, j'ai vu qu'il était plus complexe de copier des graphiques.

Merci d'avance pour vos coups de main!

-- 02 Aoû 2011, 00:16 --

Après un petit combat avec visual studio qui ne voulait pas m'activer la bibliothèque je ne sais pourquoi, j'ai réussi à coller le graph dans un nouveau powerpoint. A part quelques décalages des légendes et autres, c'est pas mal!

Par contre, je suis toujours intéressé pour utiliser un modèle de ppt dans lequel je collerai mes graphiques et également sur une petite piste pour faire une boite de dialogue dans laquelle on peut cocher des options avant de répondre (je sais pas si c'est clair)!

Merci d'avance!

Re le forum

Tu parles de modèle, dans Excel ou PowerPoint.

Merci de préciser les versions de PowerPoint et d'Excel utilisées,

cela peut engendrer des disfonctionnements selon les versions.

Mytå

Effectivement, excuse moi, je voudrais utiliser un modèle pour powerpoint ; mais je suis aussi intéressé pour faire d'autre exports qui seront des fichiers de travail donc ça m'intéresse un peu pour le trio word, excel, powerpoint!

Sinon, j'ai Office 2007 sur mon ordi perso et 2010 sur celui du boulot (qui est moins puissant, donc je suis plus intéressé par la version 2007, mais toujours preneur d'infos supplémentaires!)

Re le forum

Essaye de fournir un peu de matériel, car je travaille à l'aveuglette. (Ma boule de cristal est cassée)

Reuk a écrit :

Par contre, je suis toujours intéressé pour utiliser un modèle de ppt dans lequel je collerai mes graphiques et également sur une petite piste pour faire une boite de dialogue dans laquelle on peut cocher des options avant de répondre (je sais pas si c'est clair)!

Il n'y a rien de clair, tu donnes un bout de code pour faire un graphique dans Excel,

ensuite tu parles de modèles dans PowerPoint et finalement tu rajoutes Word comme

cerise sur le gâteau.

PowerPoint est assez grand pour faire lui-même ses graphiques sans passer par un modèle.

Trop de question dans la même ficelle, de quoi décourager bien des bénévoles.

Mytå

P.S. Je viens de passer une heure pour générer un graphique dans PowerPoint depuis Excel (VBA).

Et cela sans avoir eu besoin d'utiliser un modèle pour PowerPoint.

Et pourquoi ne pas y ajouter un Formulaire (UserForm) pour choisir le type de graphique.

Désolé Myta,

Alors en gros quand je parle de modèle, c'est un fichier avec un fond, une mise en forme et d'autres trucs déjà définis.

Donc pour powerpoint, une présentation vierge en quelque sorte (le modèle de présentation de l'entreprise quoi...)

Après le fait de passer par excel ou powerpoint pour faire des graphiques ne change rien pour moi, c'est surtout que je n'ai pas réussi à trouver les commandes qui permettent d'ouvrir un fichier modèle et de générer des graphiques directement avec powerpoint... Si j'ai les fonctions, je saurais l'adapter dans mon programme après, avec ptet un peu de débug...

Pour la matière, je peux te fournir le code complet de macro (c'est long parce qu'il y a pas mal de traitement avant) mais je suis pas sûr que ça aide.

Word, c'est un peu un bonus, si vous me dites juste ou je peux trouver les infos sur les fonctions, je devrais pouvoir me débrouiller seul.

Et pour la boite de dialogue, je posterai un autre sujet!

-- 02 Aoû 2011, 14:15 --

Je met le code, au cas où, mais c'est plutôt un coup à se perdre, surtout que j'ai fait quelques spaghettis dans le tas...

Avec les instructions ou juste un fichier d'aide clair et accessible, je devrais m'en sortir pour adapter à mes besoins!

Sub TimeToFailure()

Application.ScreenUpdating = False
l = 2
m = 2

Sheets.Add After:=Sheets(Sheets.Count)
ActiveWorkbook.Sheets(Sheets.Count).Activate
Sheets(Sheets.Count).Name = "TTF"

For zz = 1 To 5
    ActiveWorkbook.ActiveSheet.Cells(1, zz) = ActiveWorkbook.Sheets("Feuille Codes").Cells(1, zz + 1)
    Next zz

ActiveWorkbook.ActiveSheet.Cells(1, 6) = "Date"
ActiveWorkbook.ActiveSheet.Cells(1, 7) = "Heure"
ActiveWorkbook.ActiveSheet.Cells(1, 8) = "Tps Arrêt"
ActiveWorkbook.ActiveSheet.Cells(1, 9) = "Etat"
ActiveWorkbook.ActiveSheet.Cells(1, 10) = "TTF"

For i = 327 To 388
Sheets("TTF").Activate
    If ActiveWorkbook.Sheets("Feuille Codes").Cells(i, 2) = 0 Then GoTo skipcalcul2:

    For zz = 1 To 5
    ActiveWorkbook.ActiveSheet.Cells(l, zz) = ActiveWorkbook.Sheets("Feuille Codes").Cells(i, zz + 1)
    Next zz
    m = l

    For k = 2 To 250000

        If (Sheets("Données").Cells(k, 12) <> Sheets("Feuille Codes").Cells(i, 6)) Then GoTo skipcalcul

        If ((Sheets("Données").Cells(k, 4) = "PREVENTIF") Or (Sheets("Données").Cells(k, 4) = "PREV-SUPERVISION")) Then GoTo skipcalcul

        If ((Sheets("Données").Cells(k, 4) = "CORR-SITE") Or (Sheets("Données").Cells(k, 4) = "CORR-INJUST") Or (Sheets("Données").Cells(k, 4) = "CORR-ASSIST") Or (Sheets("Données").Cells(k, 4) = "CORR-SUPERVISION")) Then

        Range(ActiveWorkbook.Sheets("Données").Cells(k, 6), ActiveWorkbook.Sheets("Données").Cells(k, 7)).Copy
        ActiveWorkbook.ActiveSheet.Cells(l, 6).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        ActiveWorkbook.Sheets("Données").Cells(k, 25).Copy
        ActiveWorkbook.ActiveSheet.Cells(l, 8).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        ActiveWorkbook.ActiveSheet.Cells(l, 9) = ActiveWorkbook.Sheets("Données").Cells(k, 20)
        l = l + 1
        End If

skipcalcul:
Next k

    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(ActiveSheet.Cells(m, 6), ActiveSheet.Cells(l - 1, 6)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(ActiveSheet.Cells(m, 7), ActiveSheet.Cells(l - 1, 7)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(ActiveSheet.Cells(m, 6), ActiveSheet.Cells(l - 1, 9))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

For zz = m + 1 To l - 1
    ActiveSheet.Cells(zz, 10).NumberFormat = "[h]:mm:ss"
    If ActiveSheet.Cells(zz, 6) - ActiveSheet.Cells(zz - 1, 6) + ActiveSheet.Cells(zz, 7) - ActiveSheet.Cells(zz - 1, 7) - ActiveSheet.Cells(zz - 1, 8) > 0 Then
    ActiveSheet.Cells(zz, 10) = ActiveSheet.Cells(zz, 6) - ActiveSheet.Cells(zz - 1, 6) + ActiveSheet.Cells(zz, 7) - ActiveSheet.Cells(zz - 1, 7) - ActiveSheet.Cells(zz - 1, 8)
    Else
    ActiveSheet.Cells(zz, 10) = ""
    End If
Next zz

    ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
    ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.ActiveSheet.Sort
        .SetRange Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10))
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Dim cmpt As Integer
Dim n As Long

cptremoy = 0

        ActiveSheet.Cells(m - 1, 12) = "Moyenne TTF"
recalcmoy:
ctestremoy = 0
        ActiveSheet.Cells(m, 12) = Application.WorksheetFunction.Average(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))
        ActiveSheet.Cells(m, 12).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(m + 1, 12) = "Ecart type TTF"
        ActiveSheet.Cells(m + 2, 12) = WorksheetFunction.StDev(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))
        ActiveSheet.Cells(m + 2, 12).NumberFormat = "[h]:mm:ss"

        If cptremoy > 2 Then GoTo skipfiltr:
        For ww = m + 1 To l - 1
            If ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(m, 12) + 2 * ActiveSheet.Cells(m + 2, 12) Then
                ActiveSheet.Cells(ww, 11) = ActiveSheet.Cells(ww, 10)
                ActiveSheet.Cells(ww, 10) = ""
                ctestremoy = 1
            End If
        Next ww
        If ctestremoy = 1 Then
        cptremoy = cptremoy + 1
        End If

        If cptremoy > 0 Then GoTo recalcmoy:
skipfiltr:

        'Calcul du nombre de données pour normaliser le graph
        nbdonnees = 0
        For ww = m + 1 To l - 1

                    If ActiveSheet.Cells(ww, 10) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
        Next ww
        n = Int(Sqr(nbdonnees))

        Range(Cells(m, 14), Cells(m + 3, 16)).NumberFormat = "[h]:mm:ss"

        ActiveSheet.Cells(m - 1, 13) = "Nombre de classes"
        ActiveSheet.Cells(m - 1, 14) = "Amplitude classes"
        ActiveSheet.Cells(m - 1, 15) = "Max"
        ActiveSheet.Cells(m - 1, 16) = "Min"

        For j = 0 To 3
        Sheets("TTF").Activate
        Range(ActiveSheet.Cells(m, 14), ActiveSheet.Cells(m + 3, 16 + n + j)).NumberFormat = "[h]:mm:ss"
        Range(ActiveSheet.Cells(m + 2 * j + 5, 17), ActiveSheet.Cells(m + 2 * j + 5, 16 + n + j)).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(m + j, 13) = n + j
        ActiveSheet.Cells(m + j, 14) = (Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10))) - Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))) / (n + j)
        ActiveSheet.Cells(m + j, 15) = Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))
        ActiveSheet.Cells(m + j, 16) = Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(m + 1, 10), ActiveSheet.Cells(l - 1, 10)))

            For w = 1 To n + j

            ActiveSheet.Cells(m - 1, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(m + j, 16 + w) = ActiveSheet.Cells(m + j, 16) + w * ActiveSheet.Cells(m + j, 14)
            ActiveSheet.Cells(m + 4, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(m + 2 * j + 5, 16 + w) = ActiveSheet.Cells(m + j, 16) + (2 * w - 1) / 2 * ActiveSheet.Cells(m + j, 14)
                cmpt = 0
                For ww = m + 1 To l - 1

                    If ((ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(m + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(m + j, 16 + w))) Then
                    cmpt = cmpt + 1
                    End If
                Next ww

            ActiveSheet.Cells(m + 2 * j + 6, 16 + w) = cmpt / (ActiveSheet.Cells(m + j, 14) * nbdonnees)
            Next w

        Sheets("TTF").Activate
        Next j

skipcalcul2:

Next i

Dim cmptm As Integer
        Dim nm As Long

        cptremoym = 0

        ActiveSheet.Cells(20, 12) = "Moyenne TTF MTIPF SI"
recalcmoym:
        ctestremoym = 0
        ActiveSheet.Cells(21, 12) = Application.WorksheetFunction.Average(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 11)))
        ActiveSheet.Cells(21, 12).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(22, 12) = "Ecart type TTF MTIPF SI"
        ActiveSheet.Cells(23, 12) = WorksheetFunction.StDev(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 11)))
        ActiveSheet.Cells(23, 12).NumberFormat = "[h]:mm:ss"

        If cptremoym > 1 Then GoTo skipfiltrm:
        For ww = 2 To l
            If ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(21, 12) + 4 * ActiveSheet.Cells(23, 12) Then
                ActiveSheet.Cells(ww, 10) = ""
                ctestremoym = 1
            End If
            If ActiveSheet.Cells(ww, 11) >= ActiveSheet.Cells(21, 12) + 4 * ActiveSheet.Cells(23, 12) Then
                ActiveSheet.Cells(ww, 11) = ""
                ctestremoym = 1
            End If
        Next ww
        If ctestremoym = 1 Then
        cptremoym = cptremoym + 1
        End If

        If cptremoym > 0 Then GoTo recalcmoym:
skipfiltrm:

        'Calcul du nombre de données pour normaliser le graph
        nbdonnees = 0
        For ww = 2 To l - 1

                    If ActiveSheet.Cells(ww, 10) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
                    If ActiveSheet.Cells(ww, 11) <> "" Then
                    nbdonnees = nbdonnees + 1
                    End If
        Next ww
        nm = Int(Sqr(nbdonnees))

        Range(Cells(20, 14), Cells(23, 16)).NumberFormat = "[h]:mm:ss"

        ActiveSheet.Cells(20, 13) = "Nombre de classes"
        ActiveSheet.Cells(20, 14) = "Amplitude classes"
        ActiveSheet.Cells(20, 15) = "Max"
        ActiveSheet.Cells(20, 16) = "Min"

        For j = 0 To 5
        Sheets("TTF").Activate
        Range(ActiveSheet.Cells(20, 14), ActiveSheet.Cells(26, 16 + nm + j)).NumberFormat = "[h]:mm:ss"
        Range(ActiveSheet.Cells(20 + 2 * j + 5, 17), ActiveSheet.Cells(20 + 2 * j + 5, 16 + nm + j)).NumberFormat = "[h]:mm:ss"
        ActiveSheet.Cells(21 + j, 13) = nm + j
        ActiveSheet.Cells(21 + j, 14) = (Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10))) - Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10)))) / (nm + j)
        ActiveSheet.Cells(21 + j, 15) = Application.WorksheetFunction.Max(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10)))
        ActiveSheet.Cells(21 + j, 16) = Application.WorksheetFunction.Min(Range(ActiveSheet.Cells(2, 10), ActiveSheet.Cells(l, 10)))
        Range(ActiveSheet.Cells(28 + 2 * j, 17), ActiveSheet.Cells(28 + 2 * j, 16 + nm + j)).NumberFormat = "[h]:mm:ss"

            For w = 1 To nm + j

            ActiveSheet.Cells(20, 16 + w) = "Max classe " & w
            ActiveSheet.Cells(21 + j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + w * ActiveSheet.Cells(21 + j, 14)
            ActiveSheet.Cells(27, 16 + w) = "Centre classe " & w
            ActiveSheet.Cells(28 + 2 * j, 16 + w) = ActiveSheet.Cells(21 + j, 16) + (2 * w - 1) / 2 * ActiveSheet.Cells(21 + j, 14)

                cmptm = 0
                For ww = 2 To l

                    If ((ActiveSheet.Cells(ww, 10) >= ActiveSheet.Cells(21 + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(21 + j, 16 + w))) Then
                    cmptm = cmptm + 1
                    End If
                    If ((ActiveSheet.Cells(ww, 11) >= ActiveSheet.Cells(21 + j, 15 + w)) And (ActiveSheet.Cells(ww, 10) <= ActiveSheet.Cells(21 + j, 16 + w))) Then
                    cmptm = cmptm + 1
                    End If
                Next ww

            ActiveSheet.Cells(29 + 2 * j, 16 + w) = cmptm / (ActiveSheet.Cells(21 + j, 14) * nbdonnees)
            Next w

            Set gr = ActiveWorkbook.Charts.Add
                With gr
                .SetSourceData Source:=Range(Sheets("TTF").Cells(28 + 2 * j, 17), Sheets("TTF").Cells(29 + 2 * j, 16 + nm + j)), PlotBy:=xlRows
                .ChartType = xlXYScatterSmooth
                .Location Where:=xlLocationAsNewSheet

                .HasTitle = True
                .ChartTitle.Characters.Text = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(21 + j, 13)
                .SeriesCollection(1).Name = Sheets("Feuille Codes").Cells(i, 6)
                .Name = Sheets("Feuille Codes").Cells(i, 6) & " " & Sheets("TTF").Cells(21 + j, 13)
                .Axes(xlCategory, xlPrimary).HasTitle = True
                .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "TTF"
                .Axes(xlValue, xlPrimary).HasTitle = True
                .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Nb"
                .PlotArea.Interior.ColorIndex = 2
                .Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
                .ChartArea.Font.Size = 14
                .Deselect
                End With

'faire le ménage
Set gr = Nothing

      Sheets("TTF").Activate
        Next j

Application.ScreenUpdating = True

End Sub

Re le forum

Reuk, voila un exemple pour faire un Graphique dans PowerPoint sans utiliser de "Fichier Modèle"

Si tu veux travailler avec un "Fichier Modèle" il faudrait avoir un exemple avec les informations

Logos, Style de graphique, Boite de Texte ...

Mytå

Merci Mytå pour ces précisions bien utiles!

Sinon pour l'ouverture d'un modèle, apparement il suffirait de faire

 expression.Add(Modèle)

avec Modèle comme chemin d'accès au fichier modèle

J'ai pas encore testé, mais ça devrai le faire avec ce que tu m'as donné comme détails dans le code!

Et petite question comme ça, vous auriez un fichier d'aide à me conseiller qui répertorierai (de manière "logique" si possible) les différentes fonctions en VBA avec leurs spécificités (paramètres, ...)?

Re le forum

Pour modifier un présentation déjà existante il faut remplacer

Set oPPTFile = oPPTApp.Presentations.Add
par
Set oPPTFile = oPPTApp.Presentations.Open("C:\LaPresentation.ppt")

Pour le reste du code tu vas devoir adapter car ton modèle possède déjà une présentation.

With oPPTFile
    'insère le texte "Bonjour" dans la deuxième zone de texte, du 3eme slide
    .Slides(3).Shapes(2).TextFrame.Text = "Bonjour"
End With

Mytå

Yop yop!

Merci Myta!

Rechercher des sujets similaires à "vba inserer graphiques fichiers ppt doc modeles"