(Excel] Macro pr un tableau croisé dynamique

Caliméro -  
 caliméro -
Bonjour,
A partir d'un tableau de donné, 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 colonne mais en nombre de ligne).

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

Range("A1:K" & ActiveCell.Row).Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:ActiveCell.Row").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:= _
"Nature", ColumnFields:="Site du correspondant", PageFields:=Array("Année", _
"Mois", "Jour", "Heure")
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Type"). _
Orientation = xlDataField
End Sub

J'espère avoir expliquer de manière claire mon problème. Merci
Configuration: Windows XP Internet Explorer 6.0

7 réponses

  1.
    amine69500 Messages postés 471 Statut Membre 12
     
    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
    0
  2. Caliméro
     
    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 ?
    0
  3. Caliméro
     
    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 ...
    0
  4. Caliméro
     
    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
    0
    1. amine69500 Messages postés 471 Statut Membre 12
       
      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
      0
    2. amine69500 Messages postés 471 Statut Membre 12
       
      bonjour

      bon apparament ca marche j'espere , sinon tien moi au courant

      bonn journer
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. caliméro
     
    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
    0
    1. amine69500 Messages postés 471 Statut Membre 12
       
      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
      0
  7. caliméro
     
    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 ?
    0
    1. amine69500 Messages postés 471 Statut Membre 12
       
      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
      0
  8. caliméro
     
    ^^ c'est pas vraiment ça que je te demandais ... ça je l'avais déjà fait. Bon ba tanpis je laisse tomber. Merci quand même pour ton aide ! :)
    0

Discussions similaires

Reactiver la fusion des cellules, tableau exc
chector10 -
chector10 -

38 réponses
Transformer un chiffre en lettres dans excel sans macro
vincentphilippos -
tontong -

6 réponses