Discussion :

[clévic]

Bonjour à tous,
J'ai essayé de mettre en place une macro qui totalise les valeurs numériques de cellules colorées manuellement. La macro me répond toujours 0.
Je remercie tous ceux qui pourrait m'aider pour résoudre ce problème.
Je joins la macro.
Cordialement.
Clévic

[rjamin]

Bonjour,
Dans la procédure de calcul de la somme remplacer
Cellule.Value par Cells(i,j).Value

[casefayere]

Bonjour,
tu peux essayer ce code

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
Private Sub CommandButton5_Click()
 
'Calcule la somme des cellules sélectionnées
Dim i As Integer, j As Integer, n As Integer, t As Currency
Dim Plage As Range, cel As Range
t = 0
With Sheets("feuil1")
  Set Plage = .Range("B4:B12") 'pour une colonne, pour 2 .Range("B4:C12")
End With
For Each cel In Plage
  If cel.Interior.ColorIndex = 5 Then
    t = t + cel
  End If
Next cel
Cells(1, 10) = t
 
End Sub

[dark_sidious]

Bonjour à tous,
Tu peux également essayer ce code :

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
Private Sub UserForm_Initialize()
    Dim Couleur As Long
    Dim color As String
    Dim tablo()
 
 'récupère la couleur RGB de la police de la cellule
Set mon_dico = CreateObject("Scripting.dictionary")
Set ma_plage = Range("a1:c8")
For Each cell In ma_plage
 
c = cell.Interior.color
    Bleu = c \ 65536
    Vert = (c - Bleu * 65536) \ 256
    Rouge = c - Bleu * 65536 - Vert * 256
    color = Rouge & "," & Vert & "," & Bleu
'Me.Label1.Caption = cell
If Not mon_dico.exists(cell.Interior.ColorIndex & cell.Font.color) Then
i = i + 1
    mon_dico.Add cell.Interior.ColorIndex & cell.Font.color, i
    ReDim Preserve tablo(1 To 6, 1 To i)
    tablo(1, i) = cell
    tablo(2, i) = color
    tablo(3, i) = Bleu
    tablo(4, i) = Vert
    tablo(5, i) = Rouge
    tablo(6, i) = cell.Font.color
Else
    For p = 1 To UBound(tablo, 2)
        If tablo(2, p) = color And tablo(6, p) = cell.Font.color Then
            If cell Like "*[*a-z*]*" Then
                tablo(1, p) = tablo(1, p) & " " & cell
            Else
                tablo(1, p) = tablo(1, p) + cell
            End If
        End If
    Next p
   ' mon_dico.Item(cell.Interior.ColorIndex) = mon_dico.Item(cell.Interior.ColorIndex) + cell
End If
'MsgBox tablo(1, 4)
 
Next cell
For m = 1 To UBound(tablo, 2)
    'MsgBox tablo(1, m) & " - " & tablo(2, m)
Next m
For h = 1 To mon_dico.Count
 Set Obj = Me.Controls.Add("forms.Label.1")
    With Obj
        .Name = "Label" & h
        '.Object.Value = "Kv" & i
        .Left = PosX
        .Top = 30 * ((h - 1) Mod 5) + 40
        .Width = 50
        .Height = 20
        .BackColor = RGB(tablo(5, h), tablo(4, h), tablo(3, h)) 'mon_dico.Item(i)
        .Caption = tablo(1, h)
        .ForeColor = tablo(6, h)
    End With
    Set Cl = New Classe1
    Set Cl.Label = Obj
    If h Mod 5 = 0 Then PosX = PosX + 80
Next h
 
End Sub

Il te fait la somme de toutes les couleurs présentes dans la selection, en rappelant les couleurs dans l'userform...

En espérant que cela t'aide.

[nibledispo]

bonjour,

voici ton code corrigé sans fioriture.
la boucle j était inutile et comme dit plus haut cellule devient cells(i,2).

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Couleur()
 
'Calcule la somme des cellules sélectionnées
Dim i As Integer
' dim t as ????
t = 0
For i = 4 To 12
        If Cells(i, 2).Interior.ColorIndex = 5 Then
           t = t + Cells(i, 2).Value
        End If
Next i
Cells(1, 10) = t
 
End Sub

cordialement.