Bonjour,
j'ai un code VBA en entreprise que je ne comprend pas du tout et va falloir que je le modifie plus tard, donc je me demandais si quelqu'un pourrait me le traduire pas à pas ?
Ca serait extraordinaire et ca me sauverai au yeux de mon patron :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
 
Option Compare Text
Dim TblBD(), Choix(), NomTableau, NbCol, ChoixCombo()
 
Private Sub ComboTri_click()
  Dim tbl()         'Dimensionnement Tableau
  colTri = Me.ComboTri.ListIndex
  tbl = Me.ListBox1.List
  TriMultiCol tbl, LBound(tbl), UBound(tbl), colTri
  Me.ListBox1.List = tbl
End Sub
 
Private Sub CommandButton1_Click()
Unload UserForm1
 
End Sub
 
Private Sub CommandButton2_Click()
Unload UserForm1
 
End Sub
 
Private Sub Label3_Click()
 
End Sub
 
Private Sub Label5_Click()
 
End Sub
 
Private Sub UserForm_Initialize()
  NomTableau = "tableau1"                             ' adapter
  TblBD = Range(NomTableau).Value
  ReDim Choix(1 To UBound(TblBD))
  For i = LBound(TblBD) To UBound(TblBD)
     NbCol = Range(NomTableau).Columns.Count
     For k = 1 To NbCol: Choix(i) = Choix(i) & TblBD(i, k) & "|": Next k
  Next i
  Me.ListBox1.List = TblBD
  EnteteListBox
  ChoixCombo = ListeMotsTab(Range(NomTableau))
  Me.ComboBox1.List = ListeMotsTab(Range(NomTableau))
  Me.ComboTri.List = Application.Transpose(Range(NomTableau).Offset(-1).Resize(1))  ' Ordre tri
End Sub
 
Private Sub TextBox1_Change()
  If Me.TextBox1 <> "" Then
     mots = Split(Me.TextBox1, " ")
     tbl = Choix
     For i = LBound(mots) To UBound(mots)
       tbl = Filter(tbl, mots(i), True, vbTextCompare)
     Next i
     n = UBound(tbl) + 1
     If n > 0 Then
       ReDim Tbl2(LBound(tbl) To n + 1, 1 To NbCol)
       For j = LBound(tbl) To UBound(tbl)
         a = Split(tbl(j), "|")
         For k = 0 To NbCol - 1: Tbl2(j, k + 1) = a(k): Next k
       Next j
       Me.ListBox1.List = Tbl2
      Else
       Me.ListBox1.Clear
      End If
    Else
      Me.ListBox1.List = TblBD
    End If
End Sub
 
Sub EnteteListBox()
  NbCol = Range(NomTableau).Columns.Count
  x = Me.ListBox1.Left + 8
  Y = Me.ListBox1.Top - 12
  For i = 1 To NbCol
    Set lab = Me.Controls.Add("Forms.Label.1")
    lab.Caption = Range(NomTableau).Offset(-1).Cells(1, i)
    lab.Top = Y
    lab.Left = x
    x = x + Range(NomTableau).Columns(i).Width * 0.9
    temp = temp & Range(NomTableau).Columns(i).Width * 0.9 & ";"
  Next
  Me.ListBox1.ColumnCount = NbCol
  temp = Left(temp, Len(temp) - 1)
  Me.ListBox1.ColumnWidths = temp
End Sub
 
Private Sub b_raz_Click()
  Me.TextBox1 = ""
End Sub
 
Private Sub ComboBox1_Click()
  Me.TextBox1 = Me.TextBox1 & " " & ComboBox1
End Sub
Private Sub B_result_Click()
  Set f2 = Sheets("RESULTATS")
  f2.Cells.ClearContents
  a = Me.ListBox1.List
  f2.[A2].Resize(UBound(a) + 1, UBound(a, 2) + 1) = a
  c = 0
  For c = 1 To NbCol
     f2.Cells(1, c) = Range(NomTableau).Offset(-1).Item(1, c)
  Next
  f2.Cells.EntireColumn.AutoFit
End Sub
 
Private Sub ComboBox1_Change()
 If Me.ComboBox1.ListIndex = -1 Then
   Me.ComboBox1.List = Filter(ChoixCombo, Me.ComboBox1.Text, True, vbTextCompare)
   Me.ComboBox1.DropDown
  Else
 
  End If
End Sub
Sub TriMultiCol(a(), gauc, droi, colTri) ' Quick sort
  Dim colD, colF, ref, g, d, c, temp
  colD = LBound(a, 2): colF = UBound(a, 2)
  ref = a((gauc + droi) \ 2, colTri)
  g = gauc: d = droi
  Do
    Do While a(g, colTri) < ref: g = g + 1: Loop
    Do While ref < a(d, colTri): d = d - 1: Loop
    If g <= d Then
      For c = colD To colF
        temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
      Next
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then TriMultiCol a, g, droi, colTri
  If gauc < d Then TriMultiCol a, gauc, d, colTri
End Sub
 
Function ListeMotsTab(champ As Range)
  exclus = Array("le", "les", "des", "sur", "elle", "est", "ses")
  Dim temp()
  a = champ
  Set mondico = CreateObject("Scripting.Dictionary")
  For Each c In a
    b = Split(Replace(c, "x", " "), " ")
    For Each k In b
      If Len(k) > 2 And Not IsNumeric(k) And IsError(Application.Match(k, exclus, 0)) Then
         mondico.Item(LCase(k)) = LCase(k)
      End If
    Next k
  Next c
  Dim tbl()
  ReDim tbl(1 To mondico.Count)
  i = 1
  For Each c In mondico.items
    tbl(i) = c
    i = i + 1
  Next
  Tri tbl, LBound(tbl), mondico.Count
  ListeMotsTab = tbl
End Function
Sub Tri(a(), gauc, droi)          ' Quick sort
 ref = a((gauc + droi) \ 2)
 g = gauc: d = droi
 Do
     Do While a(g) < ref: g = g + 1: Loop
     Do While ref < a(d): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
 Loop While g <= d
 If g < droi Then Call Tri(a, g, droi)
 If gauc < d Then Call Tri(a, gauc, d)
End Sub