Ajout d'une ligne qui trace les bordure et remplissage à une macro déjà fonctionnelle

**INFINITY100** · 05/05/2015, 13h48

Bonjour tous le monde

Voila j'ai une macro qui fonctionne très à un détail pré que je veux ajouter à cette macro, en effet je voudrai que quand les données sont envoyées à la page voulu les cases soit avec des bordures horizontales et verticales en format simples ainsi que le remplissage jaune avec écriture bleu nuit et pour le total général qui défile en dernier remplissage gris écriture rouge

Merci d'avance pour votre aide

Cordialement

Voici ma macro

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Private Sub CommandButton1_Click()
  Dim Ctrl As Control
  Dim r As Integer
  Dim Derligne As Integer
  Dim LigneDebut As Long
  Dim x As Integer, L As Integer, nombre_de_colonne As Integer
  Dim Ligne As Long, Celluledebut As Integer, Cellulefin As Integer
  Dim Celluledebut2 As Integer, Cellulefin2 As Integer
  Dim Ind As Integer, sTabF() As String
 
 
  ' Définir le tableau des feuilles à modifier
  sTabF = Split("Feuil1,Feuil2", ",")
  ' Pour chaque feuille
  For Ind = 0 To UBound(sTabF)
    ' Avec la feuille "Ind"
    With Worksheets(sTabF(Ind))
      LigneDebut = 12
      Derligne = .Range("A" & Cells.Rows.Count).End(xlUp).Row + 1
      If .Cells(Derligne - 1, 1).Value = "Total général" Then Derligne = Derligne - 1
      Ligne = Derligne
      Celluledebut = 3: Cellulefin = 5
            .Range(.Cells(Ligne, Celluledebut), .Cells(Ligne, Cellulefin)).Merge
            Celluledebut2 = 7: Cellulefin2 = 9
      .Range(.Cells(Ligne, Celluledebut2), .Cells(Ligne, Cellulefin2)).Merge
      For Each Ctrl In UserForm1.Controls
        r = Val(Ctrl.Tag)
        If r > 0 Then
            If Ctrl.Name = "TextBox2" Then
                .Cells(Derligne, r) = Val(Ctrl)
                .Cells(Derligne, r).NumberFormat = "#,##0.00"
            Else
                .Cells(Derligne, r) = Ctrl
            End If
 
        End If
      Next
      ' Mettre le total du tableau
      nombre_de_colonne = 2
      L = .Cells(Rows.Count, 1).End(xlUp).Row
      For x = 2 To nombre_de_colonne
        .Cells(L + 1, x).Formula = "=SUM(" & .Cells(12, x).Address & ":" & .Cells(L, x).Address & ")"
        .Cells(L + 1, x).NumberFormat = "#,##0.00"
        .Cells(L + 1, x - 1).Value = "Total général"
      Next
    End With
  Next Ind
  TextBox1 = ""
  Unload Me
End Sub

**Theze** · 05/05/2015, 14h28

Bonjour,

Je ne reprends que le code du 1er bloc If...Then et pour le total, tu peux t'inspirer du code ci-dessous en modifiant les valeurs de "ColorIndex" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
If r > 0 Then
 
    If Ctrl.Name = "TextBox2" Then
 
        .Cells(Derligne, r) = Val(Ctrl)
        .Cells(Derligne, r).NumberFormat = "#,##0.00"
 
    Else
 
        .Cells(Derligne, r) = Ctrl
 
    End If
 
     With .Cells(Derligne, r)
 
        .Value = Ctrl
        .Borders(7).Weight = 2
        .Borders(8).Weight = 2
        .Borders(9).Weight = 2
        .Borders(10).Weight = 2
        .Interior.ColorIndex = 6
        .Font.ColorIndex = 11
 
    End With
 
End If

Hervé.

**Theze** · 05/05/2015, 14h29

petite rectification dans le code (ligne parasite ".Value = Ctrl"), tester celui-ci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
If r > 0 Then
 
    If Ctrl.Name = "TextBox2" Then
 
        .Cells(Derligne, r) = Val(Ctrl)
        .Cells(Derligne, r).NumberFormat = "#,##0.00"
 
    Else
 
        .Cells(Derligne, r) = Ctrl
 
    End If
 
     With .Cells(Derligne, r)
 
        .Borders(7).Weight = 2
        .Borders(8).Weight = 2
        .Borders(9).Weight = 2
        .Borders(10).Weight = 2
        .Interior.ColorIndex = 6
        .Font.ColorIndex = 11
 
    End With
 
End If

Hervé.

**INFINITY100** · 05/05/2015, 18h33

Merci Hervé

effectivement la macro fonctionne mais pas dans sa totalité car avec le code que tu ma fait elle carde et colore que les cellule A et B or dans ma macro je veux toute les colonne concernée par la fusion c'est à dire de A à I

Bref je joins le fichier pour être plus claire

Merci encore une fois

Cordialement

**Theze** · 06/05/2015, 07h15

Bonjour,

Teste ce code pour voir si il convient :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
 
Private Sub CommandButton1_Click()
 
    Dim Ctrl As Control
    Dim r As Integer
    Dim Derligne As Integer
    Dim Ind As Integer
    Dim sTabF() As String
 
 
    'Définir le tableau des feuilles à modifier
    sTabF = Split("Feuil1,Feuil2", ",")
 
    ' Pour chaque feuille
    For Ind = 0 To UBound(sTabF)
 
        ' Avec la feuille "Ind"
        With Worksheets(sTabF(Ind))
 
            Derligne = .Range("A" & .Rows.Count).End(xlUp).Row + 1
 
            If .Cells(Derligne - 1, 1).Value = "Total général" Then Derligne = Derligne - 1
 
                .Range(.Cells(Derligne, 3), .Cells(Derligne, 5)).Merge
 
                .Range(.Cells(Derligne, 7), .Cells(Derligne, 9)).Merge
 
                For Each Ctrl In UserForm1.Controls
 
                r = Val(Ctrl.Tag)
 
                If r > 0 Then
 
                    If Ctrl.Name = "TextBox2" Then
 
                        .Cells(Derligne, r) = Val(Ctrl)
                        .Cells(Derligne, r).NumberFormat = "#,##0.00"
 
                    Else
 
                        .Cells(Derligne, r) = Ctrl
 
                    End If
 
                    With .Range(.Cells(Derligne, r), .Cells(Derligne, r).Offset(, 7))
 
                        .Borders(7).Weight = 2
                        .Borders(8).Weight = 2
                        .Borders(9).Weight = 2
                        .Borders(10).Weight = 2
                        .Borders(11).Weight = 2
                        .Interior.ColorIndex = 6
                        .Font.ColorIndex = 11
                        .Font.Bold = True
 
                    End With
 
                End If
 
            Next Ctrl
 
            Derligne = .Cells(Rows.Count, 1).End(xlUp).Row + 1
 
            .Cells(Derligne, 1).Value = "Total général"
            .Cells(Derligne, 2).Formula = "=SUM(" & .Cells(12, 2).Address & ":" & .Cells(Derligne - 1, 2).Address & ")"
            .Cells(Derligne, 2).NumberFormat = "#,##0.00"
 
            With .Range(.Cells(Derligne, 1), .Cells(Derligne, 2))
 
                .Borders(7).Weight = 2
                .Borders(8).Weight = 2
                .Borders(9).Weight = 2
                .Borders(10).Weight = 2
                .Borders(11).Weight = 2
                .Interior.ColorIndex = 16
                .Font.ColorIndex = 3
                .Font.Bold = True
 
            End With
 
        End With
 
    Next Ind
 
    TextBox1.Text = ""
 
    Unload Me
 
End Sub

Hervé.

**INFINITY100** · 07/05/2015, 03h11

Merci Hérvé

C'est parfait

Ajout d'une ligne qui trace les bordure et remplissage à une macro déjà fonctionnelle [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager