jbdubreuil
XLDnaute Occasionnel
Bonjour,
J'ai crée 4 petites macro sous excel pour changer les données d'un graph.
(etiquette, Bulle, echelle et temp)
je les ai mises "à la suite" dans le module1.
Ma question est la suivante:
Comment lancer les macro à la suite:
1) Avec un bouton
(malheureusement, une seule macro se lance, puisque le bouton est lié à un sub et end sub)
2) Sans bouton, à chaque modification du graph.
(J'ai utilisé dans mon workbook le code suivant sans resultat)
Private Sub Worksheet_Change(ByVal Target As Range)
Echelle
Colorie_Bulles
ModifieEtiquette
Temp
End Sub
Et voilà le code que j'utilise pour les 4 petites macro:
Je sais que c'est un peu brouillon ce message, désolé.
Merci pour votre aide,
Amicalement
jb
Sub Temp()
'Macro rename Etiquette
Dim a, NbVal As Integer
'Sélectionne le "chart 1"
ActiveSheet.ChartObjects("chart 1").Activate
'Définis le nombre de points dans la collection
NbVal = ActiveChart.SeriesCollection(1).Points.Count
'Affiche les etiquettes
ActiveChart.SeriesCollection(1).ApplyDataLabels 'AutoText:=True
'formate les etiquettes
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Position = xlLabelPositionCenter 'other options: xlLabelPositionInsideBase or xlLabelPositionInsideEnd
.Orientation = xlHorizontal
End With
Selection.AutoScaleFont = False
With Selection.Font
.Name = "Arial"
.Size = 6
End With
For a = 1 To NbVal
'Applique la nouvelle etiquette
ActiveChart.SeriesCollection(1).Points(a).DataLabel.Characters.Text = Range("AF1").Offset(a, 0)
Next a
End Sub
Sub ModifieEtiquette()
'Macro Etiquette
Dim Ws As Worksheet, ChartObj As ChartObject
Dim Pts As Points
Dim ValX, ValY, ValNoms, Boucle As Long
Set Ws = ActiveSheet
Set ChartObj = Ws.ChartObjects(1)
ValNoms = ChartObj.Chart.SeriesCollection("Etiquette").XValues
With ChartObj.Chart.SeriesCollection("Noms")
ValX = .XValues
ValY = .Values
Set Pts = .Points
For Boucle = 1 To Pts.Count
If ValNoms(Boucle) <> "" And ValX(Boucle) <> "" _
And ValY(Boucle) <> "" Then _
Pts(Boucle).DataLabel.Text = ValNoms(Boucle)
Next Boucle
End With
End Sub
Sub Echelle()
'Echelle automatique
With ActiveSheet.ChartObjects("chart 1").Chart.Axes(xlValue)
.MinimumScale = Application.Min(Range("AN8"))
.MaximumScale = Application.Max(Range("AN7"))
.MinorUnit = 0.05
.MajorUnit = 0.1
End With
With ActiveSheet.ChartObjects("chart 1").Chart.Axes(xlCategory)
.MinimumScale = Application.Min(Range("AN6"))
.MaximumScale = Application.Max(Range("AN5"))
.MinorUnit = 0.05
.MajorUnit = 0.1
End With
End Sub
Sub Colorie_Bulles()
'Colorie les bulles
Dim a, Color, NbVal As Integer
'Sélectionne le "chart 1"
ActiveSheet.ChartObjects("chart 1").Activate
'Définis le nombre de points dans la collection
NbVal = ActiveChart.SeriesCollection(1).Points.Count
' Sélectionne chacun des points et lui attribue
' la couleur de la cellule lui correspondant.
For a = 1 To NbVal
Color = CInt(Range("AE1").Offset(a, 0).Value)
ActiveChart.SeriesCollection(1).Points(a).Interior.ColorIndex = Color
Next a
End Sub
J'ai crée 4 petites macro sous excel pour changer les données d'un graph.
(etiquette, Bulle, echelle et temp)
je les ai mises "à la suite" dans le module1.
Ma question est la suivante:
Comment lancer les macro à la suite:
1) Avec un bouton
(malheureusement, une seule macro se lance, puisque le bouton est lié à un sub et end sub)
2) Sans bouton, à chaque modification du graph.
(J'ai utilisé dans mon workbook le code suivant sans resultat)
Private Sub Worksheet_Change(ByVal Target As Range)
Echelle
Colorie_Bulles
ModifieEtiquette
Temp
End Sub
Et voilà le code que j'utilise pour les 4 petites macro:
Je sais que c'est un peu brouillon ce message, désolé.
Merci pour votre aide,
Amicalement
jb
Sub Temp()
'Macro rename Etiquette
Dim a, NbVal As Integer
'Sélectionne le "chart 1"
ActiveSheet.ChartObjects("chart 1").Activate
'Définis le nombre de points dans la collection
NbVal = ActiveChart.SeriesCollection(1).Points.Count
'Affiche les etiquettes
ActiveChart.SeriesCollection(1).ApplyDataLabels 'AutoText:=True
'formate les etiquettes
ActiveChart.SeriesCollection(1).DataLabels.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.Position = xlLabelPositionCenter 'other options: xlLabelPositionInsideBase or xlLabelPositionInsideEnd
.Orientation = xlHorizontal
End With
Selection.AutoScaleFont = False
With Selection.Font
.Name = "Arial"
.Size = 6
End With
For a = 1 To NbVal
'Applique la nouvelle etiquette
ActiveChart.SeriesCollection(1).Points(a).DataLabel.Characters.Text = Range("AF1").Offset(a, 0)
Next a
End Sub
Sub ModifieEtiquette()
'Macro Etiquette
Dim Ws As Worksheet, ChartObj As ChartObject
Dim Pts As Points
Dim ValX, ValY, ValNoms, Boucle As Long
Set Ws = ActiveSheet
Set ChartObj = Ws.ChartObjects(1)
ValNoms = ChartObj.Chart.SeriesCollection("Etiquette").XValues
With ChartObj.Chart.SeriesCollection("Noms")
ValX = .XValues
ValY = .Values
Set Pts = .Points
For Boucle = 1 To Pts.Count
If ValNoms(Boucle) <> "" And ValX(Boucle) <> "" _
And ValY(Boucle) <> "" Then _
Pts(Boucle).DataLabel.Text = ValNoms(Boucle)
Next Boucle
End With
End Sub
Sub Echelle()
'Echelle automatique
With ActiveSheet.ChartObjects("chart 1").Chart.Axes(xlValue)
.MinimumScale = Application.Min(Range("AN8"))
.MaximumScale = Application.Max(Range("AN7"))
.MinorUnit = 0.05
.MajorUnit = 0.1
End With
With ActiveSheet.ChartObjects("chart 1").Chart.Axes(xlCategory)
.MinimumScale = Application.Min(Range("AN6"))
.MaximumScale = Application.Max(Range("AN5"))
.MinorUnit = 0.05
.MajorUnit = 0.1
End With
End Sub
Sub Colorie_Bulles()
'Colorie les bulles
Dim a, Color, NbVal As Integer
'Sélectionne le "chart 1"
ActiveSheet.ChartObjects("chart 1").Activate
'Définis le nombre de points dans la collection
NbVal = ActiveChart.SeriesCollection(1).Points.Count
' Sélectionne chacun des points et lui attribue
' la couleur de la cellule lui correspondant.
For a = 1 To NbVal
Color = CInt(Range("AE1").Offset(a, 0).Value)
ActiveChart.SeriesCollection(1).Points(a).Interior.ColorIndex = Color
Next a
End Sub