Salut

La fonction Val ne me suffisant pas, j'ai développé une fonction qui permet de récupérer un numérique dans une phrase (pour mon cas une page web) qui n'a pas toujours la même syntaxe.
Le chiffre étant pour un cas toujours le premier pour l'autre le troisième, je suis arrivé à ce code basique plutôt que d'utiliser RegExp que je n'ai pas réussis à faire fonctionner pour tout les cas de figures dont j'avais besoins.
La fonction
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
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
Un code exemple d'utilisation:
Sur un Form, déposer 5 contrôles, 1 ListBox, 1 CommandButton, 1 HScrollBar, 1 Label indexé 0, et enfin 1 TextBox indexé 0, l'ensemble des contrôles conservent leurs Name par défaut.
Tout est géré dans le Load (création (si nécessaire), dimensionnement, positionnement et configuration)
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
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
Sachant qu'il y a des gens compétant dans l'utilisation de RegExp, je serrai heureux d'avoir des propositions arrivant au même résultat (sinon mieux).