> 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
Souris Logitech MX Master 2S + Norton 360 Deluxe (3 postes, 12 mois) à 49,99 €
49,99 € 90 € -44% @Cdiscount
Lot de 2 enceintes portables Bluetooth JBL Go 3 à 49,41 € livré
49,41 € 70 € -29% @Amazon Allemagne
Processeur AMD Ryzen 7 5700G (8 coeurs, Vega 8, AM4) à 188,98 €
188,98 € 250 € -24% @Amazon
Lecteur/graveur de CD/DVD externe USB à 18,39 €
18,39 € 22,99 € -20% @Amazon
Webcam Logitech HD Pro C920 à 49,99 €
49,99 € 79 € -37% @Cdiscount
Portable 16 pouces Lenovo Legion 5i Pro (WQXGA 165Hz, Core i7, 32Go DDR5, 1To SSD, RTX3070) à 1599 €
1599 € 2299 € -30% @Lenovo
Casque sans fil à réduction de bruit Sony WH-1000XM4 (Hi-Res Audio, Bluetooth/NFC) à 232,72 € livré
232,72 € 300 € -22% @Amazon Espagne
PC fixe HP EliteDesk 800 G4 reconditionné (Core i5, 16Go RAM, SSD 512Go, Windows 10 Pro) à 249 €
249 € 400 € -38% @AfB Shop
Ecran 32 pouces incurvé KTC H32S17 (QHD, 165 Hz, 1 ms, HDR10) à 239 €
239 € 350 € -32% @AfB Shop
Batterie portable Charmast 10400 mAh 18W PD charge rapide à 17,28 €
17,28 € 26,99 € -36% @Amazon

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