Creation de graphiques par boucle VBA

william68 · 24 Septembre 2009

Bonjour,

J'essaie de créer une macro me permettant d'éditer en boucle des graphiques par rapport a une liste, des pays dans mon cas.

Les graphiques sont chacun rattaches a un tableau qui fournit les informations a tracer.

Pour chaque pays une feuille pour le tableau et une feuille pour le graphique.

Ces deux feuilles sont copier-coller par rapport a deux feuilles de reference et les informations du tableau pour le pays en question y sont copiees ensuite.

Tout marche bien dans la theorie et le premier pays me renvoie un tableau et un graphe nikel c'est des la deuxieme boucle que la je n'ai plus les infos mais un #REF dans toutes les cellules de mon tableau et donc un graphique faux egalement.

Autre probleme je renvoie dynamiquement des legendes sur le graphiques et celles-ci fonctionnent bizarrement et pas toujours de la meme facon. Je ne sais pas si ma syntaxe est exacte.

Si quelqu'un peu m'aider voici le code.

Code:

Sub Chartcreation()

Dim nome, aname As String

Application.ScreenUpdating = False

Sheets("legend").Select
Range("D2").Select
Selection.End(xlDown).Select
last_line = Selection.Row

loop_end = last_line

For i = 1 To loop_end - 2
    aname = Sheets("legend").Cells(i + 2, 4).Value 
    Sheets("pivottable").Cells(3, 2) = aname 

    Sheets(Array("Table", "Age Distribution Chart")).Select
    Sheets("Age Distribution Chart").Activate
    Sheets(Array("Table", "Age Distribution Chart")).Copy Before:=Sheets("original")
    Sheets("Table (2)").Select
    Sheets("Table (2)").Name = aname & "_TDC"
    
    Sheets("Age Distribution Chart (2)").Select
    Sheets("Age Distribution Chart (2)").Name = aname & "_AgeDC"
    Sheets("Table").Select
    Range("B11:J20").Select
    Selection.Copy
    Sheets(aname & "_TDC").Select
    Range("B11:K21").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets("Table").Select
    Range("B1:B6").Select
    Selection.Copy
    Sheets(aname & "_TDC").Select
    Range("B1:B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    Sheets(aname & "_AgeDC").Select

    Charts(aname & "_AgeDC").Shapes("Text Box 4").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(23, 7).Value     
   
    Charts(aname & "_AgeDC").Shapes("Text Box 6").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(12, 13).Value 
  
    
    Charts(aname & "_AgeDC").Shapes("Text Box 15").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(23, 13).Value 
    
    
    Charts(aname & "_AgeDC").Shapes("Text Box 11").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(1, 2).Value 
    
    
    Charts(aname & "_AgeDC").Shapes("Text Box 12").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(2, 2).Value 
    
    
    Charts(aname & "_AgeDC").Shapes("Text Box 13").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(3, 2).Value 
    
    
    Charts(aname & "_AgeDC").Shapes("Text Box 14").Select
    Selection.Characters.Text = Sheets(aname & "_TDC").Cells(4, 2).Value 
    
   
Next i
Application.ScreenUpdating = False
End Sub

Creation de graphiques par boucle VBA

william68

XLDnaute Nouveau

Discussions similaires