DepanneTonPC, dépannage et aide informatique

Bienvenue : Connexion | Inscription
La date/heure actuelle est 12 Nov 2019 à 21:56 FAQ | Rechercher | Membres | Groupes

Excel : Macro pour TCD


 
 
Ce que nous vous conseillons :
  1. Lisez les réponses ci-dessous où vous trouverez des conseils et de l'aide de la part des autres utilisateurs
  2. 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.
Poster un nouveau sujet   Répondre au sujet    DepanneTonPC Index du Forum -> Programmation et Graphisme
Voir le sujet précédent :: Voir le sujet suivant  
Auteur Message
groota



Inscrit le: 11 Juin 2009
Messages: 1

MessagePosté le: 11 Juin 2009 à 10:43    Sujet du message: Excel : Macro pour TCD Répondre en citant

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("DVery 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. Arrow 
 
Revenir en haut de page
Voir le profil de l'utilisateur Envoyer un message privé
Ajouter à : Scoopeo del.icio.us Digg this Technorati fuzz
Montrer les messages depuis:   
Poster un nouveau sujet   Répondre au sujet    DepanneTonPC Index du Forum -> Programmation et Graphisme Toutes les heures sont au format GMT + 2 Heures
 
Page 1 sur 1 

 
Sauter vers:  

Vous ne pouvez pas poster de nouveaux sujets dans ce forum
Vous ne pouvez pas répondre aux sujets dans ce forum
Vous ne pouvez pas éditer vos messages dans ce forum
Vous ne pouvez pas supprimer vos messages dans ce forum
Vous ne pouvez pas voter dans les sondages de ce forum