Afficher le détail d'une Somme.Si avec macro

[ikuchan07]

Bonjour à tous !

J'aimerais savoir s'il est possible d'afficher le détail d'une "Somme.Si.Ens" avec une macro, c'est à dire une sorte de fenêtre pop up qui s'ouvre lorsque je clique sur une cellule, me résumant quelles lignes ont été auditionnées.
Je vais tenter d'être la plus précise possible, en vous joignant le fichier avec l'exemple que j'ai fait.

Dans mon fichier, je somme les types de produits vendus selon le numéro du commercial, la catégorie et la période donnée. Certains produits font partie d'une catégorie mais d'autres ne peuvent pas être classifiés et se retrouvent dans "Autres" (feuille3).
Ceci est à titre d'exemple, le fichier que je dois monter est plus conséquent et il m'est impossible de changer de méthode, je ne peux faire mes sommes que de cette façon.

Ce que je souhaiterais c'est que lorsque je clique dans la cellule D12 (feuille3), une fenêtre s'affiche me détaillant les lignes (produits, valeur) qui ont été additionnées à partir de la "feuille2". Je ne veux que le détail de tout ce qui se retrouve dans "Autres" (feuille3).

Est-ce vraiment possible d'avoir un tel résultat ou bien y en a t-il un autre plus simple ? Car je ne m'y connais pas du tout en VBA.

Merci d'avance.

 

[job75]

Re, salut eriiiic,

Avec 10 numéros la création des 120 commentaires prend 6 secondes chez moi.

S'il y a davantage de numéros cela deviendra vite insupportable.

On peut se tourner alors vers le double-clic et ces macros :

Private Sub Worksheet_Deactivate()
Range("D7:O" & Rows.Count).ClearComments 'RAZ
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("D7:O" & Rows.Count).ClearComments 'RAZ
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, f As Variant
Set c = Intersect(Target(1).EntireRow, [B:B])
If Not c Like "Autres*" Then Exit Sub
Cancel = True
With Sheets("BDD").[A1].CurrentRegion 'nom de la feuille à adapter
    For Each c In Intersect(c.EntireRow, [D:O])
        f = c.Formula
        f = Replace(f, "A" & c.Row - 5, "A$" & c.Row - 5)
        f = Replace(Replace(Replace(Replace(f, "$A:$A", "A2"), "$B:$B", "B2"), "$C:$C", "C2"), "$D:$D", "D2")
        If Left(f, 1) <> "=" Then f = False 'pas indispensable
        .Cells(2, .Columns.Count + 2) = f 'critère de filtrage en F2
        .AdvancedFilter xlFilterInPlace, .Cells(1, .Columns.Count + 2).Resize(2)
        InsereImage .Cells, c
    Next
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    .Cells(1).Copy .Cells(1) 'vide le presse-papiers
End With
End Sub

A chaque double-clic sur une cellule des lignes "Autres" 12 commentaires sont créés.

Nouveau fichier joint.

A+

 

[ikuchan07]

Bonsoir job75 et eriiiic,

@eriiiic effectivement je pouvais également essayer de cette façon, merci à vous !

@job75 le fichier (4) ne fonctionne pas chez moi, par contre le fichier (4 bis) marche très bien. J'ai aussi remarqué qu'en ajoutant encore plus de numéro (mon fichier final est très conséquent), ça rame beaucoup !
Mais le principal c'est que votre méthode fonctionne très bien et c'est exactement ce que j'avais imaginé, c'est super bien trouvé

Merci pour ce nouveau code, je vais essayer ça devrait être plus souple.

Bonne soirée.

 

[job75]

Re,

Bien sûr on peut ne créer qu'un seul commentaire si on veut aller plus vite :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim c As Range, f As Variant
Set c = Intersect(Target(1).EntireRow, [B:B])
If Not c Like "Autres*" Or Target.Column < 4 Or Target.Column > 15 Then Exit Sub
Cancel = True
f = Target.Formula
f = Replace(f, "A" & Target.Row - 5, "A$" & Target.Row - 5)
f = Replace(Replace(Replace(Replace(f, "$A:$A", "A2"), "$B:$B", "B2"), "$C:$C", "C2"), "$D:$D", "D2")
If Left(f, 1) <> "=" Then f = False 'pas indispensable
With Sheets("BDD").[A1].CurrentRegion 'nom de la feuille à adapter
    .Cells(2, .Columns.Count + 2) = f 'critère de filtrage en F2
    .AdvancedFilter xlFilterInPlace, .Cells(1, .Columns.Count + 2).Resize(2)
    InsereImage .Cells, Target
    If .Parent.FilterMode Then .Parent.ShowAllData 'RAZ
    .Cells(1).Copy .Cells(1) 'vide le presse-papiers
End With
End Sub

Fichier (2).

A+

 

[job75]

Bonjour le forum,

Dans les 2 fichiers précédents j'ai modifié l'emplacement du Application.ScreenUpdating = False

En effet chez moi l'image/graphique apparaissait un court instant en A1.

J'ai aussi ajouté .Cells(1).Copy .Cells(1) 'vide le presse-papiers

Bonne journée.

 

[job75]

Bonjour le forum,

Sur le fichier (2) je constate que l'image ne se crée pas toujours dans le commentaire.

Du coup j'ajoute cette boucle dans la macro InsereImage des 2 fichiers précédents :

    For n = 1 To 999 'force le collage
        .Paste
        If .Pictures.Count Then Exit For
    Next
    If n=1000 Then MsgBox "Echec du collage en " & cel.Address(0, 0)

Bonne journée.

 

[ikuchan07]

Bonsoir job75,

D’accord merci beaucoup pour ces nouvelles indications, de mon côté je n’ai pas encore eu le temps de travailler sur vos récentes macro, je vous donne des nouvelles au plus vite sur ce que ça donne chez moi.

Bonne soirée.