XL 2016 VBA - Génération spontanée de l'évènement Worksheet_SelectionChange() avec SpecialCells

[Dudu2]

Bonjour,

Pasteur n'en reviendrait pas !
Dans ce fichier, le simple appel à une fonction de sommation des cellules visibles sur une feuille filtrée provoque la génération spontanée d'un évènement Worksheet_SelectionChange().

Certes je parcours les Target.SpecialCells(xlCellTypeVisible).Areas pour en extraire les valeurs, mais à aucun moment je ne provoque de sélection.
Alors comment faire cette foutue somme si ça part en Worksheet_SelectionChange() récursif à chaque fois ?

Faites le test !

 

[patricktoulon]

Bonjour à tous,

@patricktoulon, 2 soucis dans ton code:
- tu limites la somme à la 1ère colonne de la sélection (il faudrait d'ailleurs que ce soit sur l'argument rng),
- tu testes et éventuellement totalises des valeurs de cellules, y compris celles qui sont filtrées.

Dans le Post #12, le code que j'ai finalement peu amendé pour traiter les 2 problèmes cités, garde le traitement des Areas qui permet de charger des tableaux sur lesquels est faite la somme. Ça ne change pas grand chose pour de petites sélections, je suis d'accord, mais mon utilisateur fait de grandes sélections avec des tonnes de valeurs numériques.

Bonjour @Dudu2
??????????????????????????????

- tu testes et éventuellement totalises des valeurs de cellules, y compris celles qui sont filtrées.

???????????????????
ben c'est le but non ??? c'est a dire exepter les cellules non visible sinon a quoi ça sert tout ce cinéma de specialcell et areas

j'ai peut être pas compris ta demande alors
tu veux la somme de toute les cellules de toutes les ligne visible ET!!!! toutes les colonnes c'est ça

si c'est ca tu enlève .columns(1) du code c'est tout

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim adresse, som
    som = RangeSomme(Selection, adresse)
    MsgBox "Worksheet_SelectionChange Target = " & adresse & vbCrLf & " la somme est de " & som
End Sub
Function RangeSomme(rng As Range, adresse)
   Dim somm#, rng2 As Range
   For Each cel In Selection.Cells
        If IsNumeric(cel) And Not IsDate(cel) And cel.EntireRow.Hidden = False Then
        somm = somm + cel.Value
        If rng2 Is Nothing Then Set rng2 = cel Else Set rng2 = Union(rng2, cel)
   End If
   Next
    If Not rng2 Is Nothing Then adresse = rng2.Address(0, 0)
    RangeSomme = somm
End Function

je fait une plage de nombre que je filtre par colonne

résultat l'event ne se déclenche toujours qu'une fois

 

[RyuAutodidacte]

Re @Dudu2

Est ce que cela conviendrait :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False

    If Not Application.Intersect(Target, AutoFilter.Range) Is Nothing And Target.Count >= 1 And FilterMode Then
        MsgBox "La somme est de : " & CellsSum(Target)
    End If

Application.EnableEvents = True

End Sub


Function CellsSum(MyTarget As Range) As Double
Dim aSht As Worksheet, RngAF As Range, cell As Range

    If MyTarget.Count = 1 Then
        If IsNumeric(MyTarget.Value) And Not IsDate(MyTarget.Value) Then CellsSum = MyTarget.Value Else CellsSum = 0
    Else
        Set aSht = ActiveSheet
        Set RngAF = aSht.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
        Set RngAF = Intersect(RngAF, MyTarget.SpecialCells(xlCellTypeVisible)).Rows

        For Each cell In RngAF.Cells
            If IsNumeric(cell.Value) And Not IsDate(cell.Value) Then
                CellsSum = CellsSum + cell.Value ' => supp. ; If Len(cell.Text) Then
            End If
        Next cell
    
       ' If Len(CellsSum) Then CellsSum = CellsSum => ligne supprimer
    End If
End Function

Edit : me revoilà j'ai ma modif

 

[mapomme]

Re,

Juste pour le fun, deux propositions dont l'une avec une déclaration Static

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static sortir As Boolean
Dim rngVisible As Range, rngArea

   If sortir Then Exit Sub
   sortir = True: Set rngVisible = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible): sortir = False
   Set rngVisible = Intersect(Target, rngVisible)

   If Not rngVisible Is Nothing Then
      For Each rngArea In rngVisible.Areas
         '...... ce qu'on veut ......
         MsgBox rngArea.Address(0, 0)
      Next rngArea
   End If
End Sub

                              ---  ou bien  ---

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngVisible As Range, rngArea

   Application.EnableEvents = False
   Set rngVisible = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
   Application.EnableEvents = True
   Set rngVisible = Intersect(Target, rngVisible)

   If Not rngVisible Is Nothing Then
      For Each rngArea In rngVisible.Areas
         '...... ce qu'on veut ......
         MsgBox rngArea.Address(0, 0)
      Next rngArea
   End If
End Sub

 

[RyuAutodidacte]

Re,

Edit du post #17

 

[Dudu2]

Ouille ! Ça fait plein de trucs à regarder
D'abord @patricktoulon:

tu veux la somme de toute les cellules de toutes les ligne visible ET!!!! toutes les colonnes c'est ça

Non, je veux la somme du rng passé en argument, pas seulement de sa 1ère colonne comme dans ton code initial.
Function RangeSomme(rng As Range)
For Each cel In Selection.Cells -> For Each cel In rng.Cells

ben c'est le but non ??? c'est a dire exepter les cellules non visible sinon a quoi ça sert tout ce cinéma de specialcell et areas

Oui c'est le but. Mais je préfère passer par des tableaux des valeurs des Areas concernées pour faire la somme, que de tester et sommer cellule par cellule. Surtout si on inclut les cellules filtrées dans les tests. Les tableaux vont beaucoup plus vite.

@RyuAutodidacte,
En effet on peut passer par une feuille temporaire. Mais c'est quand même plus lourd que d'y aller directement.

@mapomme,
Ok, tu as déplacé la technique du flag (Static en fonction ou Private non Static en Module) et du Application.EnableEvents au niveau du Worksheet_SelectioChange().
Je n'ai pas précisé que, dans le code de l'application je fais évidemment comme toi, c.a.d. limiter la sélection au UsedRange pour éviter de traiter des millions de cellules en cas de sélection de colonnes ou lignes entières.

 

[Dudu2]

Dois-je préciser que grâce à vos indications, je suis parfaitement satisfait de la fonction suivante.
Alors je sais que certains la trouveront un peu "bavarde" mais je code aéré et commenté, it's my way

'-----------------------------
'Somme des cellules d'un Range
'-----------------------------
Private Function SommeRange(ByVal Rng As Range) As Double
    Dim TabValues() As Variant
    Dim Area As Range
    Dim Valeur As Variant
    Dim Somme As Double
    
    'Limite le Range à sommer
    If Rng Is Nothing Then Exit Function
    Set Rng = Intersect(Rng.Parent.UsedRange, Rng)
    If Rng Is Nothing Then Exit Function
    
    'Cas particulier d'un Range d'une seule cellule
    'La détection des Areas retourne toutes les lignes non filtrées de la feuille
    If Rng.Cells.Count = 1 Then
        If IsNumeric(Rng.Value) And Not IsDate(Rng.Value) Then SommeRange = Rng.Value
        Exit Function
    End If
    
    'Pour éviter la génération spontanée d'un évènement Worksheet_SelectionChange()
    'Voir https://www.excel-downloads.com/threads/vba-generation-spontanee-de-levenement-worksheet_selectionchange.20062934/
    Application.EnableEvents = False
    
    'Couvrir le dépassement de capacité
    On Error GoTo DépassementCapacité
    
    'On ne considère que les cellules non filtrées
    For Each Area In Rng.SpecialCells(xlCellTypeVisible).Areas
        If Area.Cells.Count = 1 Then
            ReDim TabValues(1 To 1)
            TabValues(1) = Area.Value
        Else
            TabValues = Area.Value
        End If
        
        For Each Valeur In TabValues
            If IsNumeric(Valeur) And Not IsDate(Valeur) Then Somme = Somme + Valeur
        Next Valeur
    Next Area
    
    'Return value
    SommeRange = Somme
    GoTo ExitFunction
    
DépassementCapacité:
    SommeRange = 0
    Beep

ExitFunction:
    On Error GoTo 0
    Application.EnableEvents = True
End Function

 

[RyuAutodidacte]

@RyuAutodidacte,
En effet on peut passer par une feuille temporaire. Mais c'est quand même plus lourd que d'y aller directement.

Oui je suis d'accord, c'est pour cela que j'ai proposé un code en post #17

Edit j'ai oublié de supprimer une ligne dans le code je le remet au propre ici

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Application.EnableEvents = False

    If Not Application.Intersect(Target, AutoFilter.Range) Is Nothing And Target.Count >= 1 Then  'And FilterMode
        MsgBox "La somme est de : " & CellsSum(Target)
    End If

Application.EnableEvents = True

End Sub


Function CellsSum(MyTarget As Range) As Double
Dim aSht As Worksheet, RngAF As Range, cell As Range

    If MyTarget.Count = 1 Then
        If IsNumeric(MyTarget.Value) And Not IsDate(MyTarget.Value) Then CellsSum = MyTarget.Value Else CellsSum = 0
    Else
        Set aSht = ActiveSheet
        Set RngAF = aSht.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible)
        Set RngAF = Intersect(RngAF, MyTarget.SpecialCells(xlCellTypeVisible)).Rows

        For Each cell In RngAF.Cells
            If IsNumeric(cell.Value) And Not IsDate(cell.Value) Then
               CellsSum = CellsSum + cell.Value
            End If
        Next cell
       
    End If
End Function