Additionner cellules de couleur Résolu

Question

Bonjour, 

J'aimerais savoir comment modifier ma macro me permettant d'additionner les cellules de couleur
La macro:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Macro permettant de mettre en couleur deux cellules cote à cote
If Not Application.Intersect(Target, Range("A1:BW40")) Is Nothing Then
With Target
  If .Interior.ColorIndex = 40 Then
    .Interior.ColorIndex = xlNone
    .Offset(1, 0).Interior.ColorIndex = xlNone
  Else
    .Interior.ColorIndex = 40
    .Offset(0, 1).Interior.ColorIndex = 40
  End If
End With
End If

Cancel = True

End Sub

Elle selectionne le texte en 1 ere colonne et sa valeur en 2eme colonne. en faisant un double clic sur la 1 ere colonne (reference texte )
Le probleme intervient sur mon autre macro qui me calcul la somme des cellules colorées:

Sub Additionner()
Dim nbcolonne As Integer, nbligne As Integer

For nbcolonne = 4 To 17

For nbligne = 5 To 30

Cells(nbligne, nbcolonne).Select

If Selection.Interior.ColorIndex = 40 Then
totalSomme = totalSomme + ActiveCell.Value
End If
Next nbligne
Next nbcolonne

Range("K1").Value = totalSomme
'Reviens à la cellule A1
Range("A1").Select


End Sub

Elle fonctionne quand il n'y a que des valeurs chiffres colorés. Sinon elle m'indique un message d'erreur '13' avec totaSomme en jaune quand les 2 cellules (texte et sa valeur) sont en couleur.
Je pense qu'elle prends en compte le texte et non  les valeurs numeriques

Peut etre y aurait il un moyen plus simple pour effectuer cette macro

J'espere ne pas avoir été  trop confus

Merci
Configuration: Windows 7 / Firefox 3.6.13

Paf · Answer

bonsoir,

tu attribues une couleur à des cellules texte et des cellules chiffrées; puis tu veux additionner ces cellules colorées (texte +nombre !) !!! ça ne peux pas marcher.

Une solution possible, attribuer une autre couleur à la cellule texte, ce qui évitera de modifier la sub additionner().


Par ailleurs dans Private Sub Worksheet_BeforeDoubleClick, si la cellule n'est pas colorée tu la colores ainsi que la cellule d'à coté ; mais si elle est déjà colorée, tu supprimes cette couleur de la cellule ainsi que celle du dessous ?

A+

Mytå · Answer

Salut le forum 

Ta macro corrigée pour ne prendre en compte que les cellules numériques


Sub Additionner() 

  Dim Col As Integer 
  Dim Lig As Integer 
  Dim TotalSomme As Single 'Ou Currency 

For Col = 4 To 17 
  For Lig = 5 To 30 
    With Cells(Lig, Col) 
      If .Interior.ColorIndex = 40 And IsNumeric(.Value) Then 
        TotalSomme = TotalSomme + .Value 
      End If 
    End With 
  Next Lig 
Next Col 

Range("K1").Value = TotalSomme 

End Sub 

Mytå

Mytå · Answer

Re le forum

Boomer, tu as mal recopier la macro : Fil d'origine


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)  

If Not Application.Intersect(Target, Range("A1:BW40")) Is Nothing Then  
With Target  
  If .Interior.ColorIndex = 40 Then  
    .Interior.ColorIndex = xlNone  
    .Offset(0, 1).Interior.ColorIndex = xlNone  
  Else  
    .Interior.ColorIndex = 40  
    .Offset(0, 1).Interior.ColorIndex = 40  
  End If  
End With  
End If  

Cancel = True  

End Sub

boomer · Answer

salut 

myta , ta macro fonctionne parfaitement
et effectivement  il y avais une inversion au niveau d'offset

Merci encore pour vos reponses , c'est sympa de me venir en aide!!!

Additionner cellules de couleur

4 réponses

Discussions similaires

Newsletters