> Tous les forums > Forum Bureautique
 Excel : Macro pour tableau croisé dynamique
Ajouter un message à la discussion
Page : [1] 
Page 1 sur 1
groota
  Posté le 11/06/2009 @ 10:45 
Aller en bas de la page 
Nouvelle astucienne

Bonjour, j’aurais besoin d’un peu d’aide par rapport à la programmation d’un macro sur excel.


À partir d'un tableau de données, je voudrais parvenir à créer un tableau croisé dynamique de manière automatique, et cela grâce à un macro.
Le problème c'est que la taille de mon tableau varie (pas en nombre de colonnes mais en nombre de lignes).

Pour l'instant mon code est : (si quelqu’un a le courage de le lire)

Sub TOUT()
'
' TOUT Macro
' Macro enregistrée le 10/06/2009 par Administrateur
'
' Touche de raccourci du clavier: Ctrl+Maj+W
'
Range("E14").Select
ActiveCell.FormulaR1C1 = "Transfert du patient conseillé"
Columns("D:D").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
Columns("K:K").Select
Selection.Insert Shift:=xlToRight

Application.DisplayAlerts = False
Columns("J:J").Select
Selection.TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Columns("K:K").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("C:C").Select
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
TrailingMinusNumbers:=True
Application.DisplayAlerts = True

Range("C1").Select
ActiveCell.FormulaR1C1 = "Jour"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Mois"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Année"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Heure"
Columns("C:F").Select
With Selection
.HorizontalAlignment = xlLeft
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 15
ActiveWindow.ScrollRow = 18
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 24
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 37
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 48
ActiveWindow.ScrollRow = 50
ActiveWindow.ScrollRow = 51
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 53
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 56
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 58
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 60
ActiveWindow.ScrollRow = 61
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 63
ActiveWindow.ScrollRow = 64
ActiveWindow.ScrollRow = 66
ActiveWindow.ScrollRow = 67
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 70
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 72
ActiveWindow.ScrollRow = 73
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 75
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 77
ActiveWindow.ScrollRow = 78
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 82
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 84
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 89
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 91
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 89
ActiveWindow.ScrollRow = 88
ActiveWindow.ScrollRow = 87
ActiveWindow.ScrollRow = 86
ActiveWindow.ScrollRow = 85
ActiveWindow.ScrollRow = 83
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 76
ActiveWindow.ScrollRow = 74
ActiveWindow.ScrollRow = 71
ActiveWindow.ScrollRow = 68
ActiveWindow.ScrollRow = 65
ActiveWindow.ScrollRow = 62
ActiveWindow.ScrollRow = 59
ActiveWindow.ScrollRow = 57
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 52
ActiveWindow.ScrollRow = 49
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 43
ActiveWindow.ScrollRow = 40
ActiveWindow.ScrollRow = 38
ActiveWindow.ScrollRow = 36
ActiveWindow.ScrollRow = 34
ActiveWindow.ScrollRow = 33
ActiveWindow.ScrollRow = 31
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 29
ActiveWindow.ScrollRow = 28
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 26
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 23
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 19
ActiveWindow.ScrollRow = 17
ActiveWindow.ScrollRow = 16
ActiveWindow.ScrollRow = 14
ActiveWindow.ScrollRow = 13
ActiveWindow.ScrollRow = 12
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 2
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
Columns("C:F").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 1
Columns("A:A").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
Columns("K:K").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
Range("G1").Select
ActiveCell.FormulaR1C1 = "Dossiers"
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R120C11").CreatePivotTable TableDestination:="", TableName:= _
"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").AddFields RowFields:= _
Array("Année", "Mois"), ColumnFields:="Site du correspondant", PageFields:= _
Array("Nature", "État")
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Dossiers"). _
Orientation = xlDataField
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "", _
xlDataAndLabel, True
ActiveSheet.PivotTables("Tableau croisé dynamique1").Format xlTable2
Range("A12").Select
Selection.Delete
Range("A12:F12").Select
Range("F12").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Range("A2,F6:F12").Select
Range("F6").Activate
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A2").Select
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1,B6:B12,C6:F13").Select
Range("C13").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("D21").Select
Range("C5:F5").Select
Range("F5").Activate
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Interior
.ColorIndex = 24
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A13:F13").Select
Range("F13").Activate
With Selection.Interior
.ColorIndex = 24
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("A6").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 47
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("D20").Select
Columns("A:A").ColumnWidth = 13
Columns("A:A").Select
Selection.ColumnWidth = 13.12
Range("D22").Select
Range("B11").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Mois"). _
PivotItems("Jan").Position = 1
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Mois"). _
PivotItems("Fev").Position = 2
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Mois"). _
PivotItems("Mar").Position = 3
Range("A6").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("A12:B12").Select
Range("B12").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Range("D21").Select
Range("A12").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Range("B12").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone







Range("A11:B11").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("A6").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Range("G3").Select

End Sub

J’ai deux problèmes face à ce code :

1. Cela ne marche que pour des tableaux de 120 lignes

(J'ai trouvé sur un forum l'astuce : Range("A1:K" & ActiveCell.Row).Select pour selectionner la cellule active mais je ne sais pas comment faire pour la suite car "Sheet1!R1C1:ActiveCell.Row") cela ne marche pas.)


2. Lorsque je filtre une caractéristique de mon TCD, deux erreurs de mise en page apparaissent :
- il y a une bordure en haut des cases A12 et B12
- La couleur de l'écriture de la case A6 n'est plus blanche, mais violet comme le fond de la case ...

Merci infiniment pour ceux qui me liront et me répondront.

Publicité
groota
 Posté le 11/06/2009 à 15:26 
Aller en bas de la page Revenir au message précédent Revenir en haut de la page
Nouvelle astucienne

Allo ? Personne veut m'aider ?

Page : [1] 
Page 1 sur 1

Vous devez être connecté pour participer à la discussion.
Cliquez ici pour vous identifier.

Vous n'avez pas de compte ? Créez-en un gratuitement !
Recevoir PC Astuces par e-mail


La Lettre quotidienne +226 000 inscrits
Avec l'actu, des logiciels, des applis, des astuces, des bons plans, ...

Les bonnes affaires
Une fois par semaine, un récap des meilleurs offres.

Les fonds d'écran
De jolies photos pour personnaliser votre bureau. Une fois par semaine.

Les nouveaux Bons Plans
Des notifications pour ne pas rater les bons plans publiés sur le site.

Les bons plans du moment PC Astuces

Tous les Bons Plans
24,95 €Baladeur encodeur K7 USB Tape2PC Blue Edition à 24,95 €
Valable jusqu'au 25 Octobre

Le vendeur Pearl fait une promotion chez Amazon sur le baladeur K7 USB Tape2PC Blue Edition qui passe à 24,95 € au lieu de 40 € habituellement. Ce baladeur vous permettra d'écouter vos anciennes K7 audio, mais aussi surtout de les numériser au format MP3 sur votre PC. Les logiciels fournis permettent de transférer et d’éditer le signal audio.


> Voir l'offre
Gratuit3 mois d'abonnement à Amazon Music Unlimited gratuits
Valable jusqu'au 24 Octobre

Amazon vous permet d'essayer son service de streaming musical pendant 3 mois gratuitement. Avec Amazon Music Unlimited, accédez à plus de 50 millions de titres, sans publicité et en illimité sur tous vos appareils : smartphone, tablette, PC/Mac, Fire, Alexa. Vous avez même la possibilité de télécharger vos playlists pour des écoutes hors connexion. A la fin de ces 3 mois, vous pourrez basculer vers l'offre payante à 9,99 € / mois ou bien arrêter sans frais le service. A noter l'existence d'une offre famille à 14,99 € / mois qui permet jusqu'à 6 utilisateurs d'écouter leur musique à tout moment et sur leurs appareils préférés. Vous pouvez annuler l'abonnement à tout moment.


> Voir l'offre
35,99 €Clé USB Sandisk Ultra Go 256 Go à double connectique USB 3.1 Type A et C à 35,99 €
Valable jusqu'au 24 Octobre

Amazon fait une promotion sur la clé USB Sandisk Ultra Go 256 Go à double connectique USB 3.1 Type A et C qui passe à 35,99 €. Cette clé USB  dispose d'un connecteur USB Type C et d'un connecteur classique de type A. Grâce à elle, transférez en toute simplicité et rapidement (jusqu'à 150 Mo/s) vos fichiers entre vos smartphones, tablettes et ordinateurs. On la trouve ailleurs à plus de 45 €.


> Voir l'offre

Sujets relatifs
option tableau croisé dynamique excel 2007
Champ texte Tableau croisé dynamique excel 2007
EXCEL tableau croisé dynamique
Creation d' une boucle macro dans fichier EXCEL pour impression
[Excel 2007] Macro : Sélection d'un tableau selon sa longueur variable
XLS 2010 tableau croisé dynamique
Macro pour ouverture d'un fichier Excel
Macro pour créer un Gencode sur Excel - EAN 18
macro pour trier un tableau et effacer les lignes sans saisie
demande astuce pour tableau excel
Plus de sujets relatifs à Excel : Macro pour tableau croisé dynamique
 > Tous les forums > Forum Bureautique