Excel : Macro pour TCD

groota · Inscrit le: 11 Juin 2009 Messages: 1

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

À 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 Very Happy

").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.

Bienvenue : Connexion \| Inscription
La date/heure actuelle est 19 Avr 2024 à 23:17	FAQ \| Rechercher \| Membres \| Groupes

Excel : Macro pour TCD
Ce que nous vous conseillons : Lisez les réponses ci-dessous où vous trouverez des conseils et de l'aide de la part des autres utilisateurs Avant de faire des modifications sur votre système ou d'installer des logiciels, nous vous recommandons fortement de cliquer ici pour scanner Windows afin de détecter les erreurs de registre.

	DepanneTonPC Index du Forum -> Programmation et Graphisme	Toutes les heures sont au format GMT + 2 Heures
Page 1 sur 1