A voir également:
- (Excel] Macro pr un tableau croisé dynamique
- Tableau croisé dynamique - Guide
- Trier un tableau excel - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Tableau word - Guide
- Comment imprimer un tableau excel sur une seule page - Guide
7 réponses
amine69500
Messages postés
422
Date d'inscription
lundi 8 juin 2009
Statut
Membre
Dernière intervention
25 août 2013
12
10 juin 2009 à 14:11
10 juin 2009 à 14:11
tu créer deux texbox et tu met dedans tes données
Dim LigneSuivante As Long
Dim i As Integer
' S'assure que Feuil1 est active
Sheets("Feuil1").Activate
' S'assure qu'un nom est entré
If TexteNom.Text = "" Then
MsgBox "Vous devez entrer un ."
TexteNom.SetFocus
Exit Sub
End If
If TextBox1.Text = "" Then
MsgBox "Vous devez entrer un ."
TextBox1.SetFocus
Exit Sub
End If
' Détermine la ligne vide suivante
LigneSuivante = _
Application.WorksheetFunction.CountA(Range("A:A")) +1
' Transfère le nom
Cells(LigneSuivante, 1) = TexteNom.Text
Cells(LigneSuivante, 2) = TextBox1.Text
' Vide les contrôles pour la prochaine entrée
TexteNom.Text = ""
TextBox1.Text = ""
TexteNom.SetFocus
TextBox1.SetFocus
End Sub
Dim LigneSuivante As Long
Dim i As Integer
' S'assure que Feuil1 est active
Sheets("Feuil1").Activate
' S'assure qu'un nom est entré
If TexteNom.Text = "" Then
MsgBox "Vous devez entrer un ."
TexteNom.SetFocus
Exit Sub
End If
If TextBox1.Text = "" Then
MsgBox "Vous devez entrer un ."
TextBox1.SetFocus
Exit Sub
End If
' Détermine la ligne vide suivante
LigneSuivante = _
Application.WorksheetFunction.CountA(Range("A:A")) +1
' Transfère le nom
Cells(LigneSuivante, 1) = TexteNom.Text
Cells(LigneSuivante, 2) = TextBox1.Text
' Vide les contrôles pour la prochaine entrée
TexteNom.Text = ""
TextBox1.Text = ""
TexteNom.SetFocus
TextBox1.SetFocus
End Sub
Merci beaucoup pour votre réponse mais je viens d'apprendre ce qu'est un macro aujourd'hui ... et je n'ai pas vraiment tout compris. Qu'est ce que je dois modifier dans votre code ? Ce que m'avais mis sers uniquement à selectionner les cellules voulu ou cela crée le tableau en même temps ?
Bonjour, est ce que quelqu'un pourrait m'aider ... :/
Pour l'instant mon code c'est :
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 2 problèmes :
1. Cela ne marche que pour des tableaux de 120 lignes
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 ...
Pour l'instant mon code c'est :
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 2 problèmes :
1. Cela ne marche que pour des tableaux de 120 lignes
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 ...
Bonjour, est ce que quelqu'un pourrait m'aider ...
Pour l'instant mon code c'est :
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 2 problèmes :
1. Cela ne marche que pour des tableaux de 120 lignes
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 beaucoup
Pour l'instant mon code c'est :
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 2 problèmes :
1. Cela ne marche que pour des tableaux de 120 lignes
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 beaucoup
amine69500
Messages postés
422
Date d'inscription
lundi 8 juin 2009
Statut
Membre
Dernière intervention
25 août 2013
12
11 juin 2009 à 10:49
11 juin 2009 à 10:49
bonjour
deja pour le 1 er probleme je pense que tu devrai adatpte ton code au nombre de ligne du tableau que tu veu sinon pour le 2eme probleme
je pense que tu devrai enleve cette ligne de ton code deja:
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
et pour la couleur
je pense qu'il faut modifier la ligne regarde a la fin du code:
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 = xlAutomatic je pense que c'est ici qu'il faut changer
End With
Range("G3").Select
deja pour le 1 er probleme je pense que tu devrai adatpte ton code au nombre de ligne du tableau que tu veu sinon pour le 2eme probleme
je pense que tu devrai enleve cette ligne de ton code deja:
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
et pour la couleur
je pense qu'il faut modifier la ligne regarde a la fin du code:
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 = xlAutomatic je pense que c'est ici qu'il faut changer
End With
Range("G3").Select
amine69500
Messages postés
422
Date d'inscription
lundi 8 juin 2009
Statut
Membre
Dernière intervention
25 août 2013
12
11 juin 2009 à 11:13
11 juin 2009 à 11:13
bonjour
bon apparament ca marche j'espere , sinon tien moi au courant
bonn journer
bon apparament ca marche j'espere , sinon tien moi au courant
bonn journer
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Tout d'abord merci beaucoup de m'avoir répondu Amine, je t'en suis très reconnaissante. J'ai essayé de changer ce que tu m'avais dit mais ça ne marche pas bien ... Il y a plusieurs " Selection.Borders(xlDiagonalUp).LineStyle = xlNone " dans mon code ; c'est lequel que je dois enlever ?
Merci encore
Merci encore
amine69500
Messages postés
422
Date d'inscription
lundi 8 juin 2009
Statut
Membre
Dernière intervention
25 août 2013
12
11 juin 2009 à 14:31
11 juin 2009 à 14:31
bonjour
a partir de la t'enleve les trois lignes (regarde les XXXXX) , et j'espere que ca marche , tien moi au courant
Range("A12:B12").Select
Range("B12").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
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 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
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 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
a partir de la t'enleve les trois lignes (regarde les XXXXX) , et j'espere que ca marche , tien moi au courant
Range("A12:B12").Select
Range("B12").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
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 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
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 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
J'ai enlevé les 3 lignes que tu m'a dit mais ça ne marche toujours pas ...
Peux-tu me mettre un copier-coller du code que je dois mettre ?
Peux-tu me mettre un copier-coller du code que je dois mettre ?
amine69500
Messages postés
422
Date d'inscription
lundi 8 juin 2009
Statut
Membre
Dernière intervention
25 août 2013
12
11 juin 2009 à 14:51
11 juin 2009 à 14:51
Range("A12:B12").Select
Range("B12").Activate
Selection.Borders(xlDiagonalDown).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
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
Range("B12").Activate
Selection.Borders(xlDiagonalDown).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
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