Excel - VBA Graphique/tableau croisé dynamique
herisson38
Messages postés
2
Date d'inscription
mercredi 11 avril 2007
Statut
Membre
Dernière intervention
14 décembre 2007
-
13 déc. 2007 à 16:17
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 - 28 févr. 2008 à 21:04
bigfish_le vrai Messages postés 1835 Date d'inscription vendredi 13 mai 2005 Statut Membre Dernière intervention 20 novembre 2013 - 28 févr. 2008 à 21:04
A voir également:
- Excel - vba graphique dynamique
- Excel vba doevents - Conseils pratiques -Visual Basic / VB.NET
- Tous les codes vba excel - Conseils pratiques -Visual Basic / VB.NET
- Byval vba - Conseils pratiques -Visual Basic / VB.NET
- Code vba excel formulaire pdf ✓ - Forum Visual Basic 6
- Excel vba dernière ligne ✓ - Forum Visual Basic 6
4 réponses
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
15
14 déc. 2007 à 16:15
14 déc. 2007 à 16:15
Bonjour,
il n'est pas possible de creer un graphique a partir de donné sur plusieurs feuille donc ici 2 solutions :
- La premiere qui serait de regrouper tes donnés dans un tableau intermediaire puis de creer un code vba(macro) qui te renvois sur les donnés d'origine, quand tu clique sur la courbe correspondante.
- La deuxieme, qui devrait etre la plus adapté si tu ne veux pax tout refaire, serait, a l'aide d'une macro, de creer temporairement une feuille ou d'utiliser un formulaire(userform) qui montre les donnés de la courbe selectioné.
Et si il y a une 3ieme solution plus simple... vois pas.
Dit nous ce qui t'arrange le plus et on vera comment t'aider
Philippe
il n'est pas possible de creer un graphique a partir de donné sur plusieurs feuille donc ici 2 solutions :
- La premiere qui serait de regrouper tes donnés dans un tableau intermediaire puis de creer un code vba(macro) qui te renvois sur les donnés d'origine, quand tu clique sur la courbe correspondante.
- La deuxieme, qui devrait etre la plus adapté si tu ne veux pax tout refaire, serait, a l'aide d'une macro, de creer temporairement une feuille ou d'utiliser un formulaire(userform) qui montre les donnés de la courbe selectioné.
Et si il y a une 3ieme solution plus simple... vois pas.
Dit nous ce qui t'arrange le plus et on vera comment t'aider
Philippe
herisson38
Messages postés
2
Date d'inscription
mercredi 11 avril 2007
Statut
Membre
Dernière intervention
14 décembre 2007
14 déc. 2007 à 19:54
14 déc. 2007 à 19:54
Merciii pour ta réponse et ton aide ...
Alors voilà un peu pplus de précisions :
- j'ai une feuille où je stocke mes données brutes,
- j'ai une 2ème feuille où je fais mes calculs intermédiaires
- j'ai une troisième feuille où je crée mes tableau croisé dynamique à partir des champs de ma 2ème feuille
> et je peux donc généré des graphiques croisés dynamique à partir de mes TCD. Donc les données sources de mes graphiques sont sur une même feuille (la 3ème).
Cela me convient tout à fait d'avoir le détail sur une nouvelle feuille lorsque je clique sur la série du graphique... comme lorsque je double-clique dans mon TCD.
Je connais un peu le vba, mais pour programmer ça, je suis un peu dépassée !! ;o)
Merci pour ton aide !!
Alors voilà un peu pplus de précisions :
- j'ai une feuille où je stocke mes données brutes,
- j'ai une 2ème feuille où je fais mes calculs intermédiaires
- j'ai une troisième feuille où je crée mes tableau croisé dynamique à partir des champs de ma 2ème feuille
> et je peux donc généré des graphiques croisés dynamique à partir de mes TCD. Donc les données sources de mes graphiques sont sur une même feuille (la 3ème).
Cela me convient tout à fait d'avoir le détail sur une nouvelle feuille lorsque je clique sur la série du graphique... comme lorsque je double-clique dans mon TCD.
Je connais un peu le vba, mais pour programmer ça, je suis un peu dépassée !! ;o)
Merci pour ton aide !!
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
15
18 déc. 2007 à 15:39
18 déc. 2007 à 15:39
Bonjour,
a mettre dans un nouveau module
Option Explicit
Dim GraphName As String, SheetName As String, NewSheetName As String, CourbeName As String
Sub LetsGo()
ConfigStart
QuelleCourbe
End Sub
Sub ConfigStart()
Application.ScreenUpdating = False 'to remove the flutter of the screen
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Unprotect
On Error Resume Next
Application.Calculation = xlCalculationManual
On Error Resume Next
Application.Calculation = xlManual
End Sub
Sub QuelleCourbe() 'ici on enregistre toutes les info sur la courbe et on _
verifi si une feuille contient deja les données
Dim Curve As Series, feuille As Worksheet
Err.Clear ' erase all last error
On Error Resume Next
CourbeName = Selection.Name
On Error Resume Next
ActiveChart.SeriesCollection(CourbeName).Select 'verif si une courbe d'un graphe a été selectioné
If Err.Number <> 0 Then TheEnd 'si ce n'est pas le cas on arrete tout
SheetName = ActiveSheet.Name
GraphName = Replace(ActiveChart.Name, SheetName & " ", "")
For Each feuille In Worksheets 'verif si une feuille contient deja les données si oui _
on l'active et on met a jour les données If feuille.Range("C2").Value GraphName And feuille.Range("C3").Value CourbeName Then
Dim lastrow As Single
feuille.Select
lastrow = Range("B:B").Find("*", [B1], , , xlByRows, xlPrevious).Row
Range(Cells(5, 2), Cells(lastrow, 3)).ClearContents
NewSheetName = feuille.Name
TransferData
End If
Next
NewSheet
End Sub
Sub NewSheet() 'ici on crée la feuille qui recevra les donnés de la courbe
Dim nsheet As Single, MyText As String
NewSheetName = GraphName & "-" & CourbeName 'creation d'un nom de feuille automatique
'-------- a partir d'ici on verifi que le nom est au format requis ou que le nom _
de la nouvelle feuille n'existe pas deja. Tu peux ajouter le controle des caracteres _ interdit pour les noms de feuille ----------------
Err.Clear
On Error Resume Next
Worksheets(NewSheetName).Select Do While Len(NewSheetName) > 31 Or Err.Number 0 'si erreure 0 c'est que la feuille existe deja.
If Err.Number = 0 Then
MyText = "Une feuille " & NewSheetName & " existe deja !"
Else
MyText = "le nom definit automatiquement ou que vous avez choisi " & _
" depasse le nombre de caractere maxi(31 maxi)."
End If
NewSheetName = InputBox(prompt:=MyText & vbCrLf & _
"Veuillez saisir un autre nom.", Default:=NewSheetName)
Err.Clear
On Error Resume Next
Worksheets(NewSheetName).Select
If NewSheetName = "exit" Then TheEnd 'pour evité de rester coincé dans la boucle
Loop
Err.Clear
'-------------------------------------------------------------
nsheet = ActiveWorkbook.Sheets.Count
Sheets.Add If NewSheetName <> "" Then ActiveSheet.Name NewSheetName ' si NewSheetName "" _
alors la nouvelle feuille prendra un nom de feuille excel par defaut
ActiveSheet.Move after:=Worksheets(Sheets.Count) 'nouvelle feuille en derniere position
'ici on en profite pour ecrire les infos qui nous servirons a detecter l'existance _
de cette feuille et mettre en forme le tableau
Range("B2", "c3").Value = "Courbe du Graph :"
Range("c2") = GraphName
Range("B3").Value = "Donné de la courbe :"
Range("c3") = CourbeName
With Range("B4")
.Value = "X"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Range("c4")
.Value = "Y"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
TransferData
End Sub
Sub TransferData() 'on transfert les données
Dim ValeurAxeX As Variant, ValeurAxeY As Variant
Worksheets(SheetName).ChartObjects(GraphName).Activate
ValeurAxeX = ActiveChart.SeriesCollection(CourbeName).XValues
ValeurAxeY = ActiveChart.SeriesCollection(CourbeName).Values
Worksheets(NewSheetName).Select
With ActiveSheet
.Range(Cells(5, 2), Cells(5 + UBound(ValeurAxeX) - 1, 2)).Value = Application.Transpose(ValeurAxeX)
.Range(Cells(5, 3), Cells(5 + UBound(ValeurAxeX) - 1, 3)).Value = Application.Transpose(ValeurAxeY)
End With
Range("B:C").Columns.AutoFit
Worksheets(SheetName).ChartObjects(GraphName).Activate 'attention cette ligne est obligatoire si tu utilise _
un evenement MousseMove pour lancer la macro car si tu ne revient pas sur la feuille a l'origine de l'evenement _
excel plante. Je dis bien excel pas la macro (gros bug que je ne sais pas gerer autrement)
TheEnd
End Sub
Sub TheEnd() 'retour à la normal
On Error Resume Next
Application.Calculation = xlCalculationAutomatic 'excel 2000 ou plus
On Error Resume Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End Sub
En suite crée un bouton, dans la feuille qui contient les graphes, et associ lui la macro "LetsGo" par un evement MousseMove obligatoirement. En effet les autres evenement font perdre le focus a la courbe selectionnée et on en a besoin pour la suite.
L'autre solution pour lancer la macro serait d'uitliser les evenements dans les graphiques
tu peux aller voir ici http://vb.developpez.com/srcvba/?page=vbaGraphiques#vbaGrapheEvents
Mais cela vas franchement ce compliquer
Je te suggere aussi d'ajouter une MsgBox en fin d'execution de macro pour limiter le lancement a 1 fois car le pb avec le MousseMove est que la macro vas ce lancer un grand nombre de fois et ton ecran vas scintillé. Ceci du fait qu'on redonne le focus a la feuille, d'ou a ete lancée la macro avant de retourner sur la feuille nouvellement créée( vois l'explication dans le code sur le bug excel).
Voila certaint diront que je t'ais macher le travail
Essaye et dit nous ce que tu en penses.
A+
a mettre dans un nouveau module
Option Explicit
Dim GraphName As String, SheetName As String, NewSheetName As String, CourbeName As String
Sub LetsGo()
ConfigStart
QuelleCourbe
End Sub
Sub ConfigStart()
Application.ScreenUpdating = False 'to remove the flutter of the screen
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Unprotect
On Error Resume Next
Application.Calculation = xlCalculationManual
On Error Resume Next
Application.Calculation = xlManual
End Sub
Sub QuelleCourbe() 'ici on enregistre toutes les info sur la courbe et on _
verifi si une feuille contient deja les données
Dim Curve As Series, feuille As Worksheet
Err.Clear ' erase all last error
On Error Resume Next
CourbeName = Selection.Name
On Error Resume Next
ActiveChart.SeriesCollection(CourbeName).Select 'verif si une courbe d'un graphe a été selectioné
If Err.Number <> 0 Then TheEnd 'si ce n'est pas le cas on arrete tout
SheetName = ActiveSheet.Name
GraphName = Replace(ActiveChart.Name, SheetName & " ", "")
For Each feuille In Worksheets 'verif si une feuille contient deja les données si oui _
on l'active et on met a jour les données If feuille.Range("C2").Value GraphName And feuille.Range("C3").Value CourbeName Then
Dim lastrow As Single
feuille.Select
lastrow = Range("B:B").Find("*", [B1], , , xlByRows, xlPrevious).Row
Range(Cells(5, 2), Cells(lastrow, 3)).ClearContents
NewSheetName = feuille.Name
TransferData
End If
Next
NewSheet
End Sub
Sub NewSheet() 'ici on crée la feuille qui recevra les donnés de la courbe
Dim nsheet As Single, MyText As String
NewSheetName = GraphName & "-" & CourbeName 'creation d'un nom de feuille automatique
'-------- a partir d'ici on verifi que le nom est au format requis ou que le nom _
de la nouvelle feuille n'existe pas deja. Tu peux ajouter le controle des caracteres _ interdit pour les noms de feuille ----------------
Err.Clear
On Error Resume Next
Worksheets(NewSheetName).Select Do While Len(NewSheetName) > 31 Or Err.Number 0 'si erreure 0 c'est que la feuille existe deja.
If Err.Number = 0 Then
MyText = "Une feuille " & NewSheetName & " existe deja !"
Else
MyText = "le nom definit automatiquement ou que vous avez choisi " & _
" depasse le nombre de caractere maxi(31 maxi)."
End If
NewSheetName = InputBox(prompt:=MyText & vbCrLf & _
"Veuillez saisir un autre nom.", Default:=NewSheetName)
Err.Clear
On Error Resume Next
Worksheets(NewSheetName).Select
If NewSheetName = "exit" Then TheEnd 'pour evité de rester coincé dans la boucle
Loop
Err.Clear
'-------------------------------------------------------------
nsheet = ActiveWorkbook.Sheets.Count
Sheets.Add If NewSheetName <> "" Then ActiveSheet.Name NewSheetName ' si NewSheetName "" _
alors la nouvelle feuille prendra un nom de feuille excel par defaut
ActiveSheet.Move after:=Worksheets(Sheets.Count) 'nouvelle feuille en derniere position
'ici on en profite pour ecrire les infos qui nous servirons a detecter l'existance _
de cette feuille et mettre en forme le tableau
Range("B2", "c3").Value = "Courbe du Graph :"
Range("c2") = GraphName
Range("B3").Value = "Donné de la courbe :"
Range("c3") = CourbeName
With Range("B4")
.Value = "X"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Range("c4")
.Value = "Y"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
TransferData
End Sub
Sub TransferData() 'on transfert les données
Dim ValeurAxeX As Variant, ValeurAxeY As Variant
Worksheets(SheetName).ChartObjects(GraphName).Activate
ValeurAxeX = ActiveChart.SeriesCollection(CourbeName).XValues
ValeurAxeY = ActiveChart.SeriesCollection(CourbeName).Values
Worksheets(NewSheetName).Select
With ActiveSheet
.Range(Cells(5, 2), Cells(5 + UBound(ValeurAxeX) - 1, 2)).Value = Application.Transpose(ValeurAxeX)
.Range(Cells(5, 3), Cells(5 + UBound(ValeurAxeX) - 1, 3)).Value = Application.Transpose(ValeurAxeY)
End With
Range("B:C").Columns.AutoFit
Worksheets(SheetName).ChartObjects(GraphName).Activate 'attention cette ligne est obligatoire si tu utilise _
un evenement MousseMove pour lancer la macro car si tu ne revient pas sur la feuille a l'origine de l'evenement _
excel plante. Je dis bien excel pas la macro (gros bug que je ne sais pas gerer autrement)
TheEnd
End Sub
Sub TheEnd() 'retour à la normal
On Error Resume Next
Application.Calculation = xlCalculationAutomatic 'excel 2000 ou plus
On Error Resume Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End
End Sub
En suite crée un bouton, dans la feuille qui contient les graphes, et associ lui la macro "LetsGo" par un evement MousseMove obligatoirement. En effet les autres evenement font perdre le focus a la courbe selectionnée et on en a besoin pour la suite.
L'autre solution pour lancer la macro serait d'uitliser les evenements dans les graphiques
tu peux aller voir ici http://vb.developpez.com/srcvba/?page=vbaGraphiques#vbaGrapheEvents
Mais cela vas franchement ce compliquer
Je te suggere aussi d'ajouter une MsgBox en fin d'execution de macro pour limiter le lancement a 1 fois car le pb avec le MousseMove est que la macro vas ce lancer un grand nombre de fois et ton ecran vas scintillé. Ceci du fait qu'on redonne le focus a la feuille, d'ou a ete lancée la macro avant de retourner sur la feuille nouvellement créée( vois l'explication dans le code sur le bug excel).
Voila certaint diront que je t'ais macher le travail
Essaye et dit nous ce que tu en penses.
A+
bigfish_le vrai
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
15
28 févr. 2008 à 21:04
28 févr. 2008 à 21:04
Salut,
le bout de code ci-dessus a été mis a jour et amelioré. Il est maintenant sous la forme d'un fichier excel telechargeable ici
A+
le bout de code ci-dessus a été mis a jour et amelioré. Il est maintenant sous la forme d'un fichier excel telechargeable ici
A+