[XL-2010] BUG ? Controls.Add("Forms.TextBox.1")

re,
j'ai créé un "appareil" qui fonctionne comme une "listbox"

cet appareil est constitué
d'une frame (avec scrollbar) : FrmResultatRecherche
dans cette Frame :
une frame (sans scrollbar) : FrmResultatRechercheScroll , qui contient des "textbox" pour chaque ligne

"textbox" ajoutées dynamiquement

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
 
Public Sub ListDataAjouter(ByVal OngletName As String, ByVal n As Single, ByVal Ligne As Single)
    If Ligne Mod 2 = 0 Then
        CouleurFond = &H80000005
    Else
        CouleurFond = &H80000018
    End If
    '-----
    Set objTxb = DataRecherche.Controls("FrmResultatRechercheScroll").Controls.Add("Forms.TextBox.1")
    objTxb.Left = 0
    objTxb.Top = (13 * Ligne - 1)
    objTxb.Width = 346
    objTxb.BorderStyle = 0 'none
    objTxb.SpecialEffect = 0 'flat
    objTxb.ForeColor = &H0
    objTxb.BackStyle = 1 '0 'transparent
    objTxb.BackColor = CouleurFond
    objTxb.Name = "TxbScrTitre" & Ligne
    objTxb.Value = Sheets(OngletName).Cells(n, ListColonNumTitre).Value 'Titre
    objTxb.FontSize = 8
    objTxb.Height = 13
    '-----
    Set objTxb = DataRecherche.Controls("FrmResultatRechercheScroll").Controls.Add("Forms.TextBox.1")
    objTxb.Left = 346 + 1
    objTxb.Top = (13 * Ligne - 1)
    objTxb.Width = 78
    objTxb.BorderStyle = 0 'none
    objTxb.SpecialEffect = 0 'flat
    objTxb.ForeColor = &H0
    objTxb.BackStyle = 1 '0 'transparent
    objTxb.BackColor = CouleurFond
    objTxb.Name = "TxbScrGenre" & Ligne
    objTxb.Value = Sheets(OngletName).Cells(n, ListColonNumGenre).Value 'Genre
    objTxb.FontSize = 8
    objTxb.Height = 13
    '-----
    Set objTxb = DataRecherche.Controls("FrmResultatRechercheScroll").Controls.Add("Forms.TextBox.1")
    objTxb.Left = 346 + 1 + 78 + 1
    objTxb.Top = (13 * Ligne - 1)
    objTxb.Width = 30
    objTxb.BorderStyle = 0 'none
    objTxb.SpecialEffect = 0 'flat
    objTxb.ForeColor = &H0
    objTxb.BackStyle = 1 '0 'transparent
    objTxb.BackColor = CouleurFond
    objTxb.Name = "TxbScrAnnee" & Ligne
    objTxb.Value = Sheets(OngletName).Cells(n, ListColonNumAnnee).Value 'Annee
    objTxb.FontSize = 8
    objTxb.Height = 13
    '-----
    Set objTxb = DataRecherche.Controls("FrmResultatRechercheScroll").Controls.Add("Forms.TextBox.1")
    objTxb.Left = 346 + 1 + 78 + 1 + 30 + 1
    objTxb.Top = (13 * Ligne - 1)
    objTxb.Width = 34
    objTxb.BorderStyle = 0 'none
    objTxb.SpecialEffect = 0 'flat
    objTxb.ForeColor = &H0
    objTxb.BackStyle = 1 '0 'transparent
    objTxb.BackColor = CouleurFond
    objTxb.Name = "TxbScrLigne" & Ligne
    objTxb.Value = n 'LigneList
    objTxb.FontSize = 8
    objTxb.Height = 13
    '-----
    Set objTxb = DataRecherche.Controls("FrmResultatRechercheScroll").Controls.Add("Forms.TextBox.1")
    objTxb.Left = 346 + 1 + 78 + 1 + 30 + 1 + 34 + 1
    objTxb.Top = (13 * Ligne - 1)
    objTxb.Width = 34
    objTxb.BorderStyle = 0 'none
    objTxb.SpecialEffect = 0 'flat
    objTxb.ForeColor = &H0
    objTxb.BackStyle = 1 '0 'transparent
    objTxb.BackColor = CouleurFond
    objTxb.Name = "TxbScrOnglet" & Ligne
    objTxb.Value = "Films"
    objTxb.FontSize = 8
    objTxb.Height = 13
    '-----
    'DataRecherche.LblGlass.ZOrder (0)
    'DataRecherche.FrmResultatRechercheScroll.Height = objTxb.Top + objTxb.Height
    'DataRecherche.LblGlass.Height = DataRecherche.FrmResultatRechercheScroll.Height
    'DataRecherche.FrmResultatRecherche.ScrollHeight = DataRecherche.FrmResultatRechercheScroll.Height
End Sub

et
un "label" : LblGlass , qui reçoit les événements (pour tous les controls "textbox")

les événements de "LblGlass"
LblGlass_MouseMove

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
 
Private Sub LblGlass_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If DataRecherche.LblGlass.BackStyle = fmBackStyleOpaque Then Exit Sub
    'ligne "pointée" = position Y / hauteur du control Txb
    Ligne = Int(Y / 13)
    'si ancienne ligne pas égal à ligne "pointée"...mouvement !!!
    If LigneLastY <> Ligne Then
        'LigneLastY est en noir...recherche la couleur d'origine
        If LigneLastY Mod 2 = 0 Then
            CouleurFond = &H80000005
        Else
            CouleurFond = &H80000018
        End If
        'LigneLastY reprend la couleur d'origine
        If ControlExists("TxbScrTitre" & LigneLastY) Then
            Me.Controls("TxbScrTitre" & LigneLastY).BackColor = CouleurFond
            Me.Controls("TxbScrTitre" & LigneLastY).ForeColor = &H0
            Me.Controls("TxbScrGenre" & LigneLastY).BackColor = CouleurFond
            Me.Controls("TxbScrGenre" & LigneLastY).ForeColor = &H0
            Me.Controls("TxbScrAnnee" & LigneLastY).BackColor = CouleurFond
            Me.Controls("TxbScrAnnee" & LigneLastY).ForeColor = &H0
            Me.Controls("TxbScrLigne" & LigneLastY).BackColor = CouleurFond
            Me.Controls("TxbScrLigne" & LigneLastY).ForeColor = &H0
            Me.Controls("TxbScrOnglet" & LigneLastY).BackColor = CouleurFond
            Me.Controls("TxbScrOnglet" & LigneLastY).ForeColor = &H0
        End If
        'LigneLastY est la nouvelle ligne
        LigneLastY = Ligne
        'LigneLastY est en noir...
        If ControlExists("TxbScrTitre" & Ligne) Then
            Me.Controls("TxbScrTitre" & Ligne).BackColor = &H0
            Me.Controls("TxbScrTitre" & Ligne).ForeColor = &H80000018
            Me.Controls("TxbScrGenre" & Ligne).BackColor = &H0
            Me.Controls("TxbScrGenre" & Ligne).ForeColor = &H80000018
            Me.Controls("TxbScrAnnee" & Ligne).BackColor = &H0
            Me.Controls("TxbScrAnnee" & Ligne).ForeColor = &H80000018
            Me.Controls("TxbScrLigne" & LigneLastY).BackColor = &H0
            Me.Controls("TxbScrLigne" & LigneLastY).ForeColor = &H80000018
            Me.Controls("TxbScrOnglet" & LigneLastY).BackColor = &H0
            Me.Controls("TxbScrOnglet" & LigneLastY).ForeColor = &H80000018
        End If
    End If
End Sub

LblGlass_MouseDown

Code:

1
2
3
4
5
6
7
8
 
Private Sub LblGlass_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If DataRecherche.LblGlass.BackStyle = fmBackStyleOpaque Then Exit Sub
    Ligne = Int(Y / 13)
    If ControlExists("TxbScrTitre" & Ligne) Then
        Call ListDataSelect(Me.Controls("TxbScrLigne" & Ligne).Value)
    End If
End Sub

voila,
j'ai utilisé des Set objTxb = Nothing
j'ai reutilisé objTxb.FontSize = 8 , après le traitement complet
rien ne fonctionne !!??

le décalage des lignes 11 et 12 se produit avec cette ligne de code

Code:

1
2
 
DataRecherche.LblGlass.Height = DataRecherche.FrmResultatRechercheScroll.Height

qui se trouve dans la procédure d'appel

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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
 
Public Sub RechercheDansTitre(objForm As Object)
    Dim n As Integer
    Dim n2 As Integer
    Dim TrouveData As Boolean
    Dim Ligne As Single
 
    Test_OperationEnCours = True
    '-----
    objForm.FrmResultatRecherche.ScrollTop = 0
    objForm.FrmResultatRecherche.ScrollHeight = 0
    objForm.LblGlass.ZOrder (0)
    DataRecherche.LblGlass.Height = 260
    objForm.FrmResultatRechercheScroll.Height = 260 '20 * 13
    '-----
    Call ControlSuprimer(objForm, objForm.FrmResultatRechercheScroll)
    '-----
    objForm.BoxNumFilmTotal.Text = ""
    objForm.BoxNumFilmFound.Text = ""
    '----- variable de recherche et controle des CheckBox
    If objForm.ChkMot1.Value = True And objForm.TxbMotEntier1 = "" And objForm.TxbMotPartiel1 = "" Then
        objForm.ChkMot1.Value = False
    Else
        If objForm.TxbMotEntier1 <> "" Then TabMotEntierOU = Split(FormatMinusculeSimple(objForm.TxbMotEntier1), ";")
        If objForm.TxbMotPartiel1 <> "" Then TabMotPartielOU = Split(FormatMinusculeSimple(objForm.TxbMotPartiel1), ";")
    End If
    If objForm.ChkMot2.Value = True And objForm.TxbMotEntier2 = "" And objForm.TxbMotPartiel2 = "" Then
        objForm.ChkMot2.Value = False
    Else
        If objForm.TxbMotEntier2 <> "" Then TabMotEntierET = Split(FormatMinusculeSimple(objForm.TxbMotEntier2), ";")
        If objForm.TxbMotPartiel2 <> "" Then TabMotPartielET = Split(FormatMinusculeSimple(objForm.TxbMotPartiel2), ";")
    End If
    If objForm.ChkMot3.Value = True And objForm.TxbMotEntier3 = "" And objForm.TxbMotPartiel3 = "" Then
        objForm.ChkMot3.Value = False
    Else
        If objForm.TxbMotEntier3 <> "" Then TabMotEntierETOU = Split(FormatMinusculeSimple(objForm.TxbMotEntier3), ";")
        If objForm.TxbMotPartiel3 <> "" Then TabMotPartielETOU = Split(FormatMinusculeSimple(objForm.TxbMotPartiel3), ";")
    End If
    '-----
    'determine Onglet
    If objForm.ChkListFilms.Value = True Then OngletName = OngletListFilms
 
    'détermine LigneListFin
    LigneListFin = ListFin(OngletName, ListColonTitre & ListLigneDebut, "U")
    'Boucle de recherche dans OngletName
    For n = ListLigneDebut To LigneListFin
        objForm.BoxNumFilmTotalProgressBar.Width = (objForm.BoxNumFilmTotal.Width / LigneListFin) * n
        DoEvents
        'décompte des lignes de OngletName du Total vers zero
        objForm.BoxNumFilmTotal.Text = LigneListFin - n
 
        '----- Data de recherche
        'Titre du film de la ligne ListColonTitre + n
        'Formate le titre -->minuscule + caracteres simples
        If objForm.ChkTitre.Value = True Then DataList = FormatMinusculeSimple(Sheets(OngletName).Range(ListColonTitre & n).Value)
        '-----
        TrouveData = False
        If objForm.ChkMot1.Value = True Then
            If objForm.TxbMotPartiel1 <> "" Then
                For n2 = 0 To UBound(TabMotPartielOU)
                    If InStr(DataList, TabMotPartielOU(n2)) > 0 Then
                        TrouveData = True
                        Exit For
                    End If
                Next n2
            End If
            If objForm.TxbMotEntier1 <> "" Then
                For n2 = 0 To UBound(TabMotEntierOU)
                    If InStr(DataList, " " & TabMotEntierOU(n2) & " ") > 0 Then
                        TrouveData = True
                        Exit For
                    End If
                Next n2
            End If
        End If
        If TrouveData = True And objForm.ChkMot3.Value = True Then
            If objForm.TxbMotPartiel3 <> "" Then
                TrouveData = False
                For n2 = 0 To UBound(TabMotPartielETOU)
                    If InStr(DataList, TabMotPartielETOU(n2)) > 0 Then
                        TrouveData = True
                        Exit For
                    End If
                Next n2
            End If
            If TrouveData = True And objForm.TxbMotEntier3 <> "" Then
                TrouveData = False
                For n2 = 0 To UBound(TabMotEntierETOU)
                    If InStr(DataList, " " & TabMotEntierETOU(n2) & " ") > 0 Then
                        TrouveData = True
                        Exit For
                    End If
                Next n2
            End If
            If TrouveData = True And objForm.ChkMot2.Value = True Then
                If objForm.TxbMotPartiel2 <> "" Then
                    For n2 = 0 To UBound(TabMotPartielET)
                        If Not InStr(DataList, " " & TabMotPartielET(n2) & " ") > 0 Then
                            TrouveData = False
                            Exit For
                        End If
                    Next n2
                End If
                If TrouveData = True And objForm.TxbMotEntier2 <> "" Then
                    For n2 = 0 To UBound(TabMotEntierET)
                        If Not InStr(DataList, " " & TabMotEntierET(n2) & " ") > 0 Then
                            TrouveData = False
                            Exit For
                        End If
                    Next n2
                End If
            End If
        ElseIf TrouveData = True And objForm.ChkMot2.Value = True Then
            If objForm.TxbMotPartiel2 <> "" Then
                For n2 = 0 To UBound(TabMotPartielET)
                    If Not InStr(DataList, " " & TabMotPartielET(n2) & " ") > 0 Then
                        TrouveData = False
                        Exit For
                    End If
                Next n2
            End If
            If TrouveData = True And objForm.TxbMotEntier2 <> "" Then
                For n2 = 0 To UBound(TabMotEntierET)
                    If Not InStr(DataList, " " & TabMotEntierET(n2) & " ") > 0 Then
                        TrouveData = False
                        Exit For
                    End If
                Next n2
            End If
        End If
        If TrouveData = True Then
            Call ListDataAjouter(OngletName, n, Ligne)
            Ligne = Ligne + 1
            DataRecherche.BoxNumFilmFound.Value = Ligne
        End If
        '-----
    Next n
    objForm.BoxNumFilmTotalProgressBar.Width = 0
    DataRecherche.LblGlass.ZOrder (0)
    DataRecherche.FrmResultatRechercheScroll.Height = DataRecherche.BoxNumFilmFound.Value * 13 '13 = hauteur de txb
    DataRecherche.LblGlass.Height = DataRecherche.FrmResultatRechercheScroll.Height
    DataRecherche.FrmResultatRecherche.ScrollHeight = DataRecherche.FrmResultatRechercheScroll.Height
    '----------------- uniquement pour test
    DataRecherche.Controls("TxbScrTitre10").FontSize = 8
    DataRecherche.Controls("TxbScrTitre10").Height = 13
    'DataRecherche.Controls("FrmResultatRechercheScroll").Controls("TxbScrTitre10").BackColor = &H0
    DataRecherche.Controls("TxbScrTitre11").FontSize = 8
    DataRecherche.Controls("TxbScrTitre11").Height = 13
    'DataRecherche.Controls("FrmResultatRechercheScroll").Controls("TxbScrTitre11").BackColor = &H0
    Test_OperationEnCours = False
End Sub

à noter :
curieusement , cette ligne fonctionne

Code:

1
2
 
DataRecherche.Controls("FrmResultatRechercheScroll").Controls("TxbScrTitre10").BackColor = &H0

bonne journée ;)
@+JP