Code VBA pour un check sur cellules

Version imprimable

09/04/2019, 12h14
guismo30

2 pièce(s) jointe(s)

Code VBA pour un check sur cellules

Bonjour à tous

Depuis deux jours maintenant j'essaye de trouver un moyen de vérifier des cellules avant l'envoie du formulaire. Mon ancien collègue avait créé un fichier excel (assez complexe) dans lequel j'ai essayé d'ajouter des formules mais sans succès (j'ai a chaque fois des messages d'erreurs)

Je suis loin d'être douée en excel raison pour laquelle je demande votre aide.

En attache je vous joins "le" fichier, sur lequel j'ai ajouté des commentaires (tab fichier fournisseur). Mon but serait au moment de l'envoie du formulaire (voir copie ecran ci-dessous), qu'un check soit fait sur le numéro de téléphone et fax et de prévenir l'utilisateur que le "leading zero", les espaces, points, virgule etc sont proscrits.
De même pour le numéro de compte banquaire et de TVA, pas d'espace de points ou caractères spéciaux..

Je vous remercie et n'hésitez pas a me contacter si vous aviez besoins de renseignements complémentaire, je serais ravie de vous les fournir. (en attache le fichier excel)

Guismo30

Bonjour,

Plutôt que de signaler les erreurs de saisie par un message, il est préférable de corriger l'erreur dès qu'elle est détectée.
Voici un bout de code à adapter qui détecte certaines anomalies et les corrige dans la foulée. Code dans le module de la feuille "Fiche fournisseur".

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Count = 1 Then
        'Contrôle des cellules de banque, téléphone et fax
        If Not Intersect(Target, Range("D23, R23, D33, D35, R33, R33, D26, O26, Y26")) Is Nothing Then
            If Target.Value <> "" Then
                If Left(Target, 1) = "0" Then Target = Right(Target, Len(Target) - 1) 'suppression du zéro non significatif
                Target = Replace(Target, ",", "", 1) 'suppression des virgules par rien
                Target = Replace(Target, " ", "", 1) 'suppression des espaces par rien
                Target = Replace(Target, "-", "", 1) 'suppression des signes "-" ou tirets par rien
                Target = Replace(Target, "+", "", 1) 'suppression des signes "+" par rien
                Target = Replace(Target, "_", "", 1) 'suppression des signes "_" ou soulignés par rien
            End If
            'Contrôles supplémentaires pour les numéros de téléphone
            If Not Intersect(Target, Range("D23, R23, D33, D35, R33, R33")) Is Nothing Then
                If Not IsNumeric(Target.Value) Then
                    MsgBox "chiffres acceptés uniquement"
                    Target = ""
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

Avec le fichier
Pièce jointe 465333

Cdlt

10/04/2019, 10h41
mercatog

Bonjour
Attention à l'utilisation de ISNUMERIC

&H2 par exemple n'est pas valide pour un n° de téléphone par exemple mais est numérique
10/04/2019, 14h06
guismo30

@ARTURO83 un tout grand merci je teste celà maintenant et vous dis quoi.