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 WithDonc 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!
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 SubRe 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 WithMytå
Yop yop!
Merci Myta!