Discussion :

[symbabeauchat]

Bonjour à tous

J'ai un champ Texte qui reçoit soit ex:80,20% ou ex:80,00 .
Le but est que: si un signe % est détecté le champ se comporte comme un champ Pourcentage sinon comme un Numérique Standard pour des calculs ultérieurs.

Après recherches j'ai trouvé sur ce site le tutoriel

Manipuler les chaînes de caractères en VB6 et VBA Excel

(merci SilkyRoad)

J'ai essayé de l'adapter à mon cas mais je butte sur la Boucle For... Next

Tant que j'utilise des Nombres avec virgule tout baigne
Mais si je saisie 80,00 (donc 2 zéros après la virgule) mon champ affiche 800
Bon aprés plusieurs heures de bataille je ne trouve pas !

Voici mon code

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
Private Sub strTxOuMntOrganisme_AfterUpdate()
On Error GoTo GestErr
 
 Dim strPourcent As String
 
   If Not IsNull(Me.strTxOuMntOrganisme) Then
 
        'supprime le signe - (Commme le Champ est "string" Abs ne fonctionne pas)
        strTxOuMntOrganisme = Replace(Me.strTxOuMntOrganisme, "-", "")
 
 
        'Rechercher "%" et le conserver dans la variable strPourcent(en fait si "%" existe Instr renvoie la Position)
        strPourcent = InStr(1, Me.strTxOuMntOrganisme, "%")
 
        'Puis supprimer le catactère "%" qui lève une erreur 13 d'Icompatibilité de Type dans le code en dessous
        strTxOuMntOrganisme = Replace(Me.strTxOuMntOrganisme, "%", "")
 
        '--Par SilkyRoad------------------------------------------------------------------------------------------'
        ' http://silkyroad.developpez.com/VBA/ManipulerChainesCaracteres/#LI-A                                    '
        '                                                                                                         '
        '        Extraire toutes les valeurs numériques (entiers et décimales) contenues dans une chaîne          '
        '                                                                                                         '
        '---------------------------------------------------------------------------------------------------------'
        Dim i As Byte, Nb As Byte
        Dim Cible As String, Resultat As String
        Dim Nombre As Double
 
        Cible = Me.strTxOuMntOrganisme
        'Pour que fonction Val puisse reconnaitre les décimales: Remplacement des
        'virgules par des points
        Cible = Replace(Cible, ",", ".")
        'Pour gérer deux nombres qui se suivent: remplacement des espaces
        'par un caractère Alpha
        Cible = Replace(Cible, " ", "x")
 
    For i = 1 To Len(Cible)
        If IsNumeric(Mid(Cible, i, 1)) Then                 
            Nombre = Val(Mid(Cible, i, Len(Cible) - i + 1)) 
            Nb = Nb + 1
            Resultat = Resultat & Nombre '& vbLf <-- mis en remarque car affiche des caractères non souhaités
            i = i + Len(Str(Nombre)) - 1                    
        End If
    Next
 
        MsgBox "Il y a " & Nb & " valeurs numériques dans la cellule " & vbLf & Resultat
 
        'Affecter le résulat
        Me.strTxOuMntOrganisme = Resultat
 
        'si il n'y qu'un chiffre aprés la Virgule-->rajouter un 0 ex:80,2 -->80,20
 
        'rechercher position de la virgule
        Dim posVirgule As Byte
        posVirgule = InStr(1, Me.strTxOuMntOrganisme, ",") 'renvoie position  0 si il n'y a pas de ","
        If posVirgule > 0 Then
            'MsgBox posVirgule
            'compte le nbre de caractères retournés aprés la virgule
            If Len(Mid(Me.strTxOuMntOrganisme, posVirgule)) = 2 Then
                    Me.strTxOuMntOrganisme = Me.strTxOuMntOrganisme & 0
            End If
 
        End If
 
        'Réaffecter le signe "%" (si l'occurence existe)
        If strPourcent <> 0 Then strTxOuMntOrganisme = strTxOuMntOrganisme & "%"
 
 End If
 
 
fin:
Exit Sub
GestErr:
     'j'affiche les codes erreurs
      MsgBox "N° erreur:" & Err.Number & vbCrLf & Err.Description, vbExclamation, "Code ERROR sur Private Sub strTxOuMntOrganisme_AfterUpdate"
      Resume fin
End Sub

Merci pour le coup de main

sbc

[marsouin_89]

Bonjour,

Je n'ai pas regardé ton code plus que çà, toutefois :

- pour utiliser une valeur string en tant que valeur numérique, il te suffit de la convertir :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Dim isNumericMyValue as double
isNumericMyValue=CDbl(Me.strTxOuMntOrganisme)

- tu n'as pas besoin de changer ta virgule en point, puisque ta valeur est convertie en numérique et que le séparateur décimale de ton panneau de configuration est la virgule.

Pars déjà sur cette base et tiens nous au courant si tu n'arrive pas à résoudre ton problème.

Cordialement

Christophe

[symbabeauchat]

Merci Christophe

Tu m'a remis sur le bon code !

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
Private Sub strTxOuMntOrganisme_AfterUpdate()
On Error GoTo GestErr
 
 Dim strPourcent As String
 
 
   If Not IsNull(Me.strTxOuMntOrganisme) Then
 
        'supprime le signe - (Commme le Champ est "string" Abs ne fonctionne pas)
        strTxOuMntOrganisme = Replace(Me.strTxOuMntOrganisme, "-", "")
 
 
        'Rechercher "%" et le conserver dans la variable strPourcent(en fait si "%" existe Instr renvoie la Position)
        strPourcent = InStr(1, Me.strTxOuMntOrganisme, "%")
 
        'Puis supprimer le catactère "%" qui lève une erreur 13 d'Icompatibilité de Type dans le code en dessous
        strTxOuMntOrganisme = Replace(Me.strTxOuMntOrganisme, "%", "")
 
        'Devient Numérique
        strTxOuMntOrganisme = CDbl(Me.strTxOuMntOrganisme)
 MsgBox strTxOuMntOrganisme
 
 
        'si il n'y qu'un chiffre aprés la Virgule-->rajouter un 0 ex:80,2 -->80,20
 
        'rechercher position de la virgule
        Dim posVirgule As Byte
        posVirgule = InStr(1, Me.strTxOuMntOrganisme, ",") 'renvoie position  0 si il n'y a pas de ","
        If posVirgule > 0 Then
            'MsgBox posVirgule
            'compte le nbre de caractères retournés aprés la virgule
            If Len(Mid(Me.strTxOuMntOrganisme, posVirgule)) = 2 Then
                    Me.strTxOuMntOrganisme = Me.strTxOuMntOrganisme & 0
            End If
 
        End If
 
        'Rajouter le signe "%"
        If strPourcent <> 0 Then strTxOuMntOrganisme = strTxOuMntOrganisme & "%"
 
 End If
 
   'Maj de DateMajAdhesion
   Me.DateMajAdhesion = Date
 
fin:
Exit Sub
GestErr:
    Select Case Err.Number
           Case Is = 13 'Incompatibilité de Type
                 MsgBox "Saisie Incompatible !", vbExclamation, "Saisie Incompatible"
                 Me.strTxOuMntOrganisme = ""
                 Resume fin
           Case Else
                'j'affiche les codes erreurs
                MsgBox "N° erreur:" & Err.Number & vbCrLf & Err.Description, vbExclamation, "Code ERROR sur Private Sub strTxOuMntOrganisme_AfterUpdate"
                Resume fin
         End Select
 
End Sub

Bon Week-end

sbc