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
| Option Explicit
Private Sub Form_Load()
'création (si nécessaire), dimensionnement, positionnement configuration des contrôles sur le formulaire
Label1(0).Move 120, 120, 1860, 195
Label1(0).Font = "MS Sans Serif"
Label1(0).FontBold = True
Label1(0).ForeColor = &H0&
Label1(0).Caption = "Exemple à sélectionner"
Load Label1(1) ' création, ajout d'un contrôle
Label1(1).Move 120, 1560, 1650, 195
Label1(1).Font = "MS Sans Serif"
Label1(1).FontBold = True
Label1(1).ForeColor = &H0&
Label1(1).Caption = "Votre propre entrée"
Load Label1(2)
Label1(2).Move 120, 2640, 4005, 195
Label1(2).Font = "MS Sans Serif"
Label1(2).FontBold = True
Label1(2).ForeColor = &HC00000
Label1(2).Caption = "Valeur retournée par la fonction RecupNumeric"
Label1(2).Visible = True
Load Label1(3)
Label1(3).Move 120, 3240, 3030, 195
Label1(3).Font = "MS Sans Serif"
Label1(3).FontBold = True
Label1(3).ForeColor = &HC00000
Label1(3).Caption = "Valeur retournée par la fonction Val"
Label1(3).Visible = True
Load Label1(4)
Label1(4).Move 120, 2250, 1200, 195
Label1(4).Font = "MS Sans Serif"
Label1(4).FontBold = True
Label1(4).ForeColor = &H0&
Label1(4).Caption = "Occurrence N°"
Label1(4).Visible = True
Load Label1(5)
Label1(5).Move 1380, 2250, 225, 195
Label1(5).Font = "MS Sans Serif"
Label1(5).FontBold = True
Label1(5).ForeColor = &H0&
Label1(5).Caption = "1"
Label1(5).Visible = True
Text1(0).Move 120, 1800, 3255, 315
Text1(0).Font = "MS Sans Serif"
Text1(0).ForeColor = &H0&
Text1(0).Text = "Essais de 16 exemples"
Load Text1(1)
Text1(1).Move 120, 2880, 4035, 315
Text1(1).Visible = True
Load Text1(2)
Text1(2).Move 120, 3480, 4035, 315
Text1(2).Visible = True
List1.Move 120, 420, 4035, 1035
List1.Font = "MS Sans Serif"
List1.ForeColor = &H0&
List1.Clear
List1.AddItem "Distance maximum: 12 mm"
List1.AddItem "Distance maximum: -12 mm"
List1.AddItem "Distance maximum: - 12 mm"
List1.AddItem "Distance maximum: 12,5 mm"
List1.AddItem "Distance maximum: 12.5 mm"
List1.AddItem "Distance maximum: .12.5, mm"
List1.AddItem "Distanse maximum: 0,12344.5, mm"
List1.AddItem "Distance maximum: 12 344,5 mm"
List1.AddItem "Distance maximum: 12 344.5 mm"
List1.AddItem "Distance maximum: 12.344.5 mm"
List1.AddItem "12 344.5 mm"
List1.AddItem " 12 344.5"
List1.AddItem "-12344.5"
List1.AddItem " - 12 - 3 --> 1° occurrence soit -12"
List1.AddItem "récupérer la 2° occurrence soit 3.52 (chiffre)"
List1.AddItem " juste un espace"
List1.AddItem "vide"
HScroll1.Move 1800, 2220, 2355, 255
HScroll1.Min = 1: HScroll1.Max = 10
HScroll1.Value = 1
Command1.Move 3480, 1800, 675, 315
Command1.Font = "MS Sans Serif"
Command1.Caption = "--> Go "
Command1_Click
Me.Caption = "Étude récupération numérique"
Me.Height = 4500: Me.Width = 4530
End Sub
Private Sub HScroll1_Change()
Label1(5).Caption = HScroll1.Value
End Sub
Private Sub HScroll1_Scroll()
HScroll1_Change
End Sub
Private Sub List1_Click()
Dim StrRecupe As String, XOccurrence As Integer
HScroll1.Value = 1
If List1.List(List1.ListIndex) = " juste un espace" Then
StrRecupe = " "
ElseIf List1.List(List1.ListIndex) = "vide" Then StrRecupe = ""
ElseIf List1.List(List1.ListIndex) = "récupérer la 2° occurrence soit 3.52 (chiffre)" Then
StrRecupe = List1.List(List1.ListIndex): HScroll1.Value = 2
Else
StrRecupe = List1.List(List1.ListIndex)
End If
Text1(0).BackColor = &HFFFFFF: List1.BackColor = &HC0FFC0
Text1(1).Text = RecupNumeric(StrRecupe, HScroll1.Value)
Text1(2).Text = Val(StrRecupe)
End Sub
Private Sub Command1_Click()
Text1(0).BackColor = &HC0FFC0: List1.BackColor = &HFFFFFF
Text1(1).Text = RecupNumeric(Text1(0).Text, HScroll1.Value)
Text1(2).Text = Val(Text1(0).Text)
End Sub
'**************** Ma fonction récupération d'un chiffre de la phrase StrSoumis ********************
Private Function RecupNumeric(StrSoumis As String, Optional Occurrence As Integer = 1) As Double
'StrSoumis, phrase ou chercher le nombre
'Occurrence, choix de la position du chiffre a récupérer
Dim Cpt As Integer ' compteur
Dim NumOccurrence As Integer ' compteur d'Occurrence
Dim NumericStr As String ' conteneur de l'entrée soumise
Dim StrNumeric As String ' conteneur de tout se qui semble numérique
Dim CharLue As String * 1 ' conteneur du caractère scanné
Dim UneDecimale As Boolean ' drapeau pour ne se limiter qu'a un séparateur décimal
NumericStr = CStr(StrSoumis)
If Len(NumericStr) = 0 Then GoTo GestErr
NumOccurrence = 1
For Cpt = 1 To Len(NumericStr)
CharLue = Mid(NumericStr, Cpt, 1)
If (CharLue = "." Or CharLue = ",") And StrNumeric = "" Then CharLue = ""
If (CharLue = "." Or CharLue = ",") And UneDecimale = True Then CharLue = ""
If IsNumeric(CharLue) Or CharLue = "." Or CharLue = "," Or CharLue = "-" Then StrNumeric = StrNumeric & CharLue
If CharLue = "." Or CharLue = "," Then
If UneDecimale = False Then UneDecimale = True Else Exit For
End If
If StrNumeric <> "" Then
If CharLue = " " And Cpt < Len(NumericStr) Then
If Not IsNumeric(Mid(NumericStr, Cpt + 1, 1)) Then
If NumOccurrence = Occurrence Then
Exit For
Else
StrNumeric = "": UneDecimale = False: NumOccurrence = NumOccurrence + 1
End If
End If
End If
End If
Next Cpt
If NumOccurrence <> Occurrence Then StrNumeric = "0"
StrNumeric = Replace(StrNumeric, ".", ",")
If IsNumeric(StrNumeric) Then RecupNumeric = CDbl(StrNumeric)
Exit Function
GestErr:
Err.Clear
RecupNumeric = 0
End Function |
