optimisation.

maguetlolo

XLDnaute Junior
Bonjour tout le monde

Voila, je modifie toute une macro sortie de l'enregistreur, mais la, apres avoir supprimé ou modifié pas mal de chose, je butte un peu.
si vous pouvez me conseillez concernant ce morceau?
Code:
Sheets("TK2").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    "$A1:$D1000").CreatePivotTable TableDestination:="", TableName:="Tableau croisé dynamique7", DefaultVersion:=xlPivotTableVersion10
        With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("TK")
    .Orientation = xlPageField
    .Position = 1
    ActiveSheet.PivotTables("Tableau croisé dynamique7").AddDataField ActiveSheet. _
        PivotTables("Tableau croisé dynamique7").PivotFields("Défaut"), _
        "Nombre de Défaut", xlCount
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("Défaut")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Tableau croisé dynamique7").PivotFields("Défaut")
        .Orientation = xlRowField
        .Position = 1
            End With
    ActiveSheet.Name = "R02"
    
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("R02").Range("$A1:$B100")
    ActiveChart.Location Where:=xlLocationAsObject, Name:= _
    "Graphiques défauts TK"

    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Nombre de défauts TK2"
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
            ActiveChart.ChartArea.Select
     ActiveChart.HasPivotFields = False
     ActiveChart.Legend.Select
    Selection.Delete
     ActiveChart.SeriesCollection(1).Select
    ActiveChart.ChartArea.Select
    ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
        HasLeaderLines:=False, ShowSeriesName:=False, ShowCategoryName:=False, _
        ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False
    ActiveSheet.Shapes("Graphique 2").IncrementLeft -226.5
    ActiveSheet.Shapes("Graphique 2").IncrementTop -89.25
    End With
       
    ActiveChart.PlotArea.Select
    With Selection.Border
        .ColorIndex = 2
        .Weight = xlThin
        .LineStyle = xlContinuous
    End With
    With Selection.Interior
        .ColorIndex = 2
        .PatternColorIndex = 1
        .Pattern = xlSolid
    End With
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScale = 120
        .MinorUnitIsAuto = True
        .MajorUnit = 20
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
        
        
    With ActiveSheet.Shapes("Graphique 2")
    .Left = Range("a27").Left
    .Top = Range("A27").Top

merci pour vos réponse
 

maguetlolo

XLDnaute Junior
Re : optimisation.

le probleme c que mon fichier fait 16 mo, je sait pas comment faire, mais tout ce que je veut, c que vous me conseiller sur mettre en forme les codes, si vous voyez une syntaxe que l'on peut raccourcir ( comme par exemple ce que j'ai déja fait : " select sheets...range() select....copy.....range ()select.....paste....." par "range()=range()") ou si vous voyez des phrase qui ne serve a rien. et puis apres je bosse, ca va me faire progresser en meme temps
 

Staple1600

XLDnaute Barbatruc
Re : optimisation.

Re

Non je ce que je veux dire c'est que pour tester des modifications sur le code VBA, il faudrait pouvoir tester sur un fichier XLS.

Exemple : j'ai commencé à modifier, J'ai remplacé (juste pour voir)

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Nombre de défauts TK2"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
ActiveChart.ChartArea.Select
ActiveChart.HasPivotFields = False
ActiveChart.Legend.Select
Selection.Delete
ActiveChart.SeriesCollection(1).Select
ActiveChart.ChartArea.Select
ActiveChart.ApplyDataLabels AutoText:=True, LegendKey:=False, _
HasLeaderLines:=False, ShowSeriesName:=False, ShowCategoryName:=False, _
ShowValue:=True, ShowPercentage:=False, ShowBubbleSize:=False
ActiveSheet.Shapes("Graphique 2").IncrementLeft -226.5
ActiveSheet.Shapes("Graphique 2").IncrementTop -89.25
End With
en
Code:
Sub test()
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Nombre de défauts TK2"
        .Legend.Delete
    End With
End Sub
(J'ai du créer un graphique fictif etc ...)
Mais c'est pas vraiment agéable à faire sans fichier
(Pour voir si ma modification fonctionne ou dysfonctionne)
Ton fichier fait 16 Mo, et Excel n'y trouve rien à redire ?
 
Dernière édition:

maguetlolo

XLDnaute Junior
Re : optimisation.

oui, désolé c vrai que c pas evident, je t'ai fait un extrait de fichier

feuil1 la liste
feuil2 ce que j'obtiens

j'espers que ce serat plus facile
merrci a toi pour ton aide
 

Pièces jointes

  • tab dyn.xls
    43.5 KB · Affichages: 70
  • tab dyn.xls
    43.5 KB · Affichages: 77
  • tab dyn.xls
    43.5 KB · Affichages: 72

Staple1600

XLDnaute Barbatruc
Re : optimisation.

Re


Dans ton fichier, il n'y pas le code VBA !

Et ton extrait de code de ton premier message, n'est pas complet.


Il manque la fin:

Code:
With ActiveSheet.Shapes("Graphique 2")
    .Left = Range("a27").Left
    .Top = Range("A27").Top
 

maguetlolo

XLDnaute Junior
Re : optimisation.

malheureusement, c tt ce que j'ai pu faire, les macros sont toute noyée entre elles, et si je la sort de son contexte, ca ne marche plus (surement possible mais je suis debutant!) c pour ca que je t'ai mis le resultat que j'avais,

mais si tu peut avec la liste creer une tableau dynamique et un graphique ayant la forme du mien (mais en ecrivant la macro, pas avec l'enregistreur) comme ca je me baserais dessus.
 

Staple1600

XLDnaute Barbatruc
Re : optimisation.

Re

Quelle est ta version d'Excel?

Peux-tu faire ce test?

A partir de ton fichier exemple

Recrée un TCD (en ayant lancer l'enregistreur de macro)

Puis enregistre ton classeur, zippes-le, et édites ton message
pour remplcer la pièce jointe par le nouveau classeur zippé.


Merci.
 

Discussions similaires

Réponses
1
Affichages
216
Réponses
0
Affichages
191

Statistiques des forums

Discussions
312 699
Messages
2 091 108
Membres
104 763
dernier inscrit
SAMI FADLI