[XL-2019] Boutons ActiveX inopérant après création ou déplacement

Bonjour et meilleurs vœux à tous, je rencontre un soucis de boutons ActiveX qui ne réagissent pas après la création ou le déplacement et gérés par un module de classe

Voici le code :

Code:

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
Option Explicit
 
Sub RechercheMultiple(Valeur)
    On Error Resume Next
    Dim lastRow As Long
    Dim cell As Range
    Dim firstCell As Range
    Dim lastCell As Long
    Dim dos As Boolean
    Dim dossier As Byte
    Dim result As Range
    Dim num As Integer
    Dim obj
    Dim L As Double
    Dim ws As Worksheet
 
    Set ws = ActiveSheet
    L = Rows(ActiveWindow.ScrollRow + 1).Top + 5
 
    ' Fermer la fenêtre VBE si elle est visible
    'If Application.VBE.MainWindow.Visible Then Application.VBE.MainWindow.Visible = False
    ' Désactiver les mises à jour de l'écran et les calculs automatiques pour améliorer les performances
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ' Fenêtre active
    With ActiveSheet
        ' Dernière ligne de la colonne M
        lastRow = Cells(.Rows.Count, "M").End(xlUp).Row
        ' Vider la zone de copie
        Range("R3:R" & Rows.Count).Clear
        ' Supprimer les boutons
        SupprimerBoutons
        ' Si la zone recherche = ""
        If Valeur = "" Then
            [Q3].Select
            Exit Sub
        End If
        ' Initialiser les variables
        Lig = 0
        num = 0
        ' Parcourir chaque cellule de la colonne L de L3 à L & lastRow
        For Each cell In Range("L3:L" & lastRow)
            ' Vérifier si la cellule a une mise en forme conditionnelle active
            If cell.DisplayFormat.Interior.Color <> cell.Interior.Color Then
                ' Définir la première cellule de la plage fusionnée
                Set firstCell = cell.MergeArea.Cells(1, 1)
                ' Vérifier si la cellule ne contient pas de fichier .ini ou .db
                If Not firstCell.Value Like "*.ini" And _
                   Not firstCell.Value Like "*.db" And _
                   Not firstCell.Value Like "*.nfo" And _
                   Not firstCell.Value Like "*.pdf" Then
                    Lig = Lig + 1
                    Set result = Range("R" & ActiveWindow.ScrollRow + Lig)
                    With result
                        ' Ajouter le lien hypertexte
                        .Hyperlinks.Add Anchor:=Range("R" & ActiveWindow.ScrollRow + Lig), _
                                        Address:=firstCell.Hyperlinks(1).Address, _
                                        TextToDisplay:=firstCell.Hyperlinks(1).TextToDisplay, _
                                        ScreenTip:=firstCell.Hyperlinks(1).Address
                        .Font.Size = 11
                        ' dossier ou fichier ?
                        dos = InStrRev(firstCell.Value, ".") > 0
                        If dos Then
                            ' Couleur de texte blanc
                            .Font.Color = RGB(255, 255, 255)
                            ' Ajouter bouton
                            With ws
                                Set obj = .OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                                                          left:=Columns("Q").left + 2.5, _
                                                          Top:=L + (Lig - 1) * 15.75, _
                                                          Width:=10.5, _
                                                          Height:=7.5)
                                With obj
                                    .Name = "Bouton" & Lig
                                    .Placement = xlMove
                                    .PrintObject = False
                                    .Locked = True
                                    .Shadow = True
                                    With .Object
                                        .Caption = num
                                        .Enabled = True
                                        .Visible = True
                                    End With
                                End With
                                num = num + 1
                            End With
                        Else
                            ' Couleur de texte bleu
                            .Value = firstCell & " (dossier)"
                            dossier = InStrRev(.Value, "(")
                            .Characters(Start:=dossier, Length:=9).Font.Size = 7
                            .Font.Bold = True
                        End If
                    End With
                End If
            End If
        Next
        ' Dernière ligne de la colonne R
        lastCell = Cells(Rows.Count, "R").End(xlUp).Row
        If lastCell > 1 Then
            ' Définir maPlage
            Set maPlage = Range("R" & ActiveWindow.ScrollRow & ":R" & lastCell)
            ' Attribuer un nom à la plage
            .Names.Add Name:="Plage", RefersTo:=maPlage
            ' Couleur de fond bleu
            maPlage.Interior.Color = RGB(0, 176, 240)
        Else
            MsgBox "Aucune correspondance", vbInformation + vbOKOnly, "Résultat"
            Exit Sub
        End If
    End With
    ' Mise en forme de la première ligne de la plage
    Entete
    [Q3].Select
    ' Initialiser les boutons
    InitialiserBoutons
    ' Réactiver les mises à jour de l'écran et les calculs automatiques
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

à la ligne 116, le code InitialiserBoutons s'exécute correctement mais aucun boutons ne réagit au clic jusqu'à ce que j'exécute manuellement ce code :

Code:

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
Dim btnCollection As Collection
Dim Boutons() As New ClsBouton
 
Sub InitialiserBoutons()
 
    Dim ws As Worksheet
    Dim btn As OLEObject
    Dim i As Integer
 
    Set ws = ActiveSheet
 
    ' Compter le nombre de boutons "Bouton?"
    i = 0
    For Each btn In ws.OLEObjects
        If TypeName(btn.Object) = "CommandButton" And left(btn.Name, 6) = "Bouton" Then
            i = i + 1
        End If
    Next btn
    ' Redimensionner le tableau pour contenir tous les boutons
    ReDim Boutons(1 To i)
    ' Initialiser les boutons
    i = 1
    For Each btn In ws.OLEObjects
        If TypeName(btn.Object) = "CommandButton" And left(btn.Name, 6) = "Bouton" Then
            Set Boutons(i).Bouton = btn.Object
            i = i + 1
        End If
    Next btn
End Sub

et le module de classe :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public WithEvents Bouton As MSForms.CommandButton
 
Private Sub Bouton_Click()
    Dim lien As String
    Dim cell As Range
 
    ' Obtenir la cellule à droite du bouton
    Set cell = Bouton.TopLeftCell.Offset(0, 1)
    ' Assigner le texte du ScreenTip comme lien hypertexte
    lien = cell.Hyperlinks(1).ScreenTip
    ' Normaliser le chemin
    lien = Replace(lien, "/", "\")
    ' Trouver le chemin du dossier
    lien = left(lien, InStrRev(lien, "\") - 1)
    ' Ouvrir le lien
    ThisWorkbook.FollowHyperlink lien
End Sub

Je vous remercie de votre attention.