Sélection en VBA

Résolu/Fermé
CHARLYJACK Messages postés 353 Date d'inscription mardi 19 octobre 2010 Statut Membre Dernière intervention 16 mai 2023 - 16 févr. 2011 à 09:35
CHARLYJACK Messages postés 353 Date d'inscription mardi 19 octobre 2010 Statut Membre Dernière intervention 16 mai 2023 - 23 févr. 2011 à 10:36
Bonjour à toutes et à tous,

Et oui je continue à m'interesser au langage VBA,
j'ai même acheté un livre.

je recherche également des codes sur internet.

La seule difficulté c'est d'appliquer les codes.

par exemple j'ai trouvé les 3 codes suivants afin d'obtenir la somme des chiffres rouges ou des cellules jaunes.
Sur une feuille ça fonctionne, par contre j'ai des difficultés dès que
j'essaie de sélectionner le classeur composé d'un nombre variable de feuilles.

voici les 3 codes que j'ai trouvés:


Calcule la somme des cellules D2 de toutes les feuilles

Sub CalculSum()
Application.ScreenUpdating = False
For Each feuille In ActiveWorkbook.Sheets
feuille.Activate
tot = [D2]
result = result + tot
Next
MsgBox result
End Sub


Fait la somme des chiffres écrits en rouge de la sélection

Sub sommeCouleurRougeText()
Dim Cellule As Range
Dim total As Variant
For Each Cellule In Selection
If Cellule.Font.ColorIndex = 3 Then

'3 rouge et 1 pour le noir

'If Cellule.Interior.ColorIndex = 3 Then (pour la couleur de fond)

If IsNumeric(Cellule) Then total = total + Cellule.Value
End If
Next
MsgBox total
Range("G12") = total
End Sub

Compte le nombre de cellules colorées en rouge de la sélection

Sub NombredeCellRouge()
Dim Cellule As Range
Dim total As Variant
For Each Cellule In Selection
If Cellule.Interior.ColorIndex = 3 Then 'rouge
total = total + Cellule.Count
End If
Next
MsgBox "Il y a " & total & " Cellules rouges"
Range("A1") = total
End Sub

merci à vous


à plus

David





2 réponses

Bonjour,

Non testé ! :

Option Explicit

Sub CalculSum()

    Dim Result As Long, Total As Variant

    Application.ScreenUpdating = False

    For Each feuille In ActiveWorkbook.Sheets
        feuille.Activate
        tot = [D2]
        Result = Result + tot
        
        ' ->>>>> Définir la sélection
        Range("A2:C5").Select
        
        ' Ajout appel de fonction
        Total = SommeCouleurRougeText(Selection)
        Range("G12").Value = Total
        
        Total = NombredeCellRouge(Selection)
        MsgBox "Il y a " & Total & " Cellules rouges"
        Range("A1").Value = Total
    
    Next
    
    MsgBox Result
    
End Sub
'

'Fait la somme des chiffres écrits en rouge de la sélection

Function SommeCouleurRougeText(ByVal Cible As Range) As Variant

    Dim Cellule As Range
    Dim Total As Variant
    
    For Each Cellule In Cible
        '3 rouge et 1 pour le noir
        If Cellule.Font.ColorIndex = 3 Then
            If IsNumeric(Cellule) Then Total = Total + Cellule.Value
        End If
    Next

    SommeCouleurRougeText = Total
    
End Function
'

'Compte le nombre de cellules colorées en rouge de la sélection

Function NombredeCellRouge(ByVal Cible As Range) As Variant

    Dim Cellule As Range
    Dim Total As Variant

    For Each Cellule In Cible
        If Cellule.Interior.ColorIndex = 3 Then 'rouge
            Total = Total + Cellule.Count
        End If
    Next

    NombredeCellRouge = Total
    
End Function
'


Info
0
CHARLYJACK Messages postés 353 Date d'inscription mardi 19 octobre 2010 Statut Membre Dernière intervention 16 mai 2023 1
23 févr. 2011 à 10:36
Merci du coup de main,
Mais J'ai essayé ça ne marche pas !
je n'arrive pas à exécuter les code
sans avoir un message d'erreur
0