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
| Option Explicit
Private O As Worksheet 'déclare la variable O (Onglet)
Private TC As Variant 'déclare la variable TC (Tableau de Cellules)
Private Sub UserForm_Initialize()
Set O = Sheets("Sheet1") 'définit l'onglet O
TC = O.Range("A7").CurrentRegion 'définit le tableau de cellules TC
Me.ListBox1.ColumnCount = UBound(TC, 2) + 1 'définit le nombre de colonnes de la ListBox1
Me.ListBox1.ColumnWidths = "0pt" 'masque la première colonne de la ListBox1
End Sub
Private Sub txt_CostCenter_Change() 'au changement dans la txt_CostCenter
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau de Lignes)
Me.ListBox1.Clear 'vide la ListBox1
If Me.txt_CostCenter.Value = "" Then Exit Sub 'si la txt_CostCenter est vide (effacée), sort de la procédure
K = 1 'initialise la variable K
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC (en partant de la seconde)
For J = 1 To UBound(TC, 2) 'boucle 2 : sur toutes les colonnes J du tableau de cellules TC
'condition : si la valeur ligne I colonne J de TC contient le texte de la txt_CostCenter
If UCase(TC(I, J)) Like "*" & UCase(Me.txt_CostCenter.Value) & "*" Then
ReDim Preserve TL(1 To UBound(TC, 2) + 1, 1 To K) 'redimensionne le tableau de lignes TL (autant de lignes que TC a de colonne plus une, K colonnes)
TL(1, K) = I 'récupère dans la ligne 1 de TL le numéro de ligne I (cette donnée sera masquée après transposition)
For L = 2 To UBound(TC, 2) + 1 'boucle 3 : sur les lignes 2 à nombre de colonnes de TC plus une, de TL
TL(L, K) = TC(I, L - 1) 'récupere dans la ligne de TL, la valeur de la colonne de TC (=> transposition)
Next L 'prochaine ligne de la boucle 3
K = K + 1 'incrément K (=> ajoute une colonne à TL)
Exit For 'sort de la boucle 2
End If 'fin de la condition
Next J 'procjaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
If K = 1 Then Exit Sub 'si K est égale à un (=> aucune occurrence vérifiant la condition), sort de la procédure
If K = 2 Then ReDim Preserve TL(1 To UBound(TL, 1), 1 To 2) 'si K=2 (=> une seule occurrence), redimensionne TL pour permettre la transposition
Me.ListBox1.List = Application.Transpose(TL) 'alimente la ListBox1 avec le trableau TL transposé (le numéro de ligne en colonne 1 est masqué)
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'au double-Click dans la ListBox1
Dim CTRL As Control 'déclare la variable TC (Tableau de Cellules)
On Error GoTo ErrorHandler
If Me.txt_CostCenter.Value = "" Then
MsgBox Application.UserName & vbNewLine & vbNewLine & "Deves prehencher o campo de procura: Search", vbExclamation, "Campo de procura vazio"
Me.txt_CostCenter.SetFocus
Exit Sub
Else
LI = CInt(Me.ListBox1.Column(0, Me.ListBox1.ListIndex)) 'récupère le numéro de ligne LI dans la colonne masquée de la ListBox1
With frm_UpdateInvoice 'prend en compte l'frm_UpdateInvoice
.Caption = "Modificar" 'change le titre
For Each CTRL In .Controls 'boucle sur tous les contrôles
'si la propriété [Tag] du contrôle n'est pas vide, récupère dans le contrôle la valeur de la cellule, ligne : LI, colonne : propriété [Tag] du contrôle convertie en byte, de l'onglet O
If CTRL.Tag <> "" Then CTRL.Value = O.Cells(LI, CByte(CTRL.Tag)).Value
Next CTRL 'prochain contrôle de la boucle
With .cbox_Supplier 'prend en compte la cbox_Supplier(Selection des fournisseur)
'sélectionne le texte
.SetFocus 'place le curseur
.SelStart = 0 'début de la sélection
.SelLength = .TextLength 'longueur de la sélection
End With 'fin de la prise en compte de la cbox_Supplier
Unload Me 'vide et ferme l'UserForm2
.Show 'affiche l'frm_UpdateInvoice
End With 'fin de la prise en compte de le frm_UpdateInvoice
End If
ErrorHandler:
Resume Next
End Sub |
