Code VBA pour afficher un message d'erreur de saisie

benjamin -
Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention - 14 févr. 2014 à 18:45

Bonsoir mes experts !!!
Me voici vers vous pour vous soumettre la résolution d'un problème que j'ai sous VBA.
En Effet j'ai un masque de saisie sous VBA à partir duquel, j'intègre des données.
Je vous informe que j'ai créé un multipage contenant 7 pages dont chacune contient en moyenne 50 textboxdans lesquels j'entre mes données pour les déverser dans une feuille excel.

Ce que je veux réaliser est que : pour le cas de la page 1 du multipage, si la valeur saisie dans l'une des textboxpas numérique, je reçoive ce message d'erreur VOUS DEVEZ SAISIR OBLIGATOIREMENT UNE VALEUR NUMERIQUE", vbInformation.
Je n'arrive pas à le faire pour l'ensemble.
Voici ce que j'ai pu faire pour les TextBox14 et TextBox15 et ca marche bien.
Private Sub CommandButton79_Click()
With Workbooks("APP.xlsx").Worksheets("Feuil1")
.Cells(1, 1).Value = TextBox14
.Cells(1, 2).Value = TextBox15
End With
WhileIsNumeric(TextBox14.Text) = False
MsgBox "VOUS DEVEZ SAISIR OBLIGATOIREMENT UNE VALEUR NUMERIQUE", vbInformation
Exit Sub
Wend
WhileIsNumeric(TextBox15.Text) = False
MsgBox "VOUS DEVEZ SAISIR OBLIGATOIREMENT UNE VALEUR NUMERIQUE", vbInformation
Exit Sub
Wend
TextBox14.Value = ""
TextBox15.Value = ""
End Sub

Mais je ne veux pas ecrire ce code pour tous les 50 textbox (c'est-à-dire 50 fois).
Comment faire ? Aidez moi à trouver un programme moins long

A voir également:

Code VBA pour afficher un message d'erreur de saisie
Code ascii - Guide
Comment recuperer un message supprimé sur whatsapp - Guide
Comment déverrouiller un téléphone quand on a oublié le code - Guide
Epingler un message whatsapp - Accueil - Messagerie instantanée
Message supprimé whatsapp - Guide

3 réponses

Réponse 1 / 3

Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention 1 204

Bonjour,

Tu peux peut être faire une fonction de contrôle qui est appelée lors de la saisie:

Option Explicit

Private Const MSG = "VOUS DEVEZ SAISIR OBLIGATOIREMENT UNE VALEUR NUMERIQUE"

Private Sub TextBox1_Change()
    If TextBox1.Text = "" Then Exit Sub
    If CtrlNumeric(TextBox1.Text) = False Then
        MsgBox MSG, vbExclamation, "Erreur saisie"
        TextBox1.Text = ""
    End If
End Sub

Function CtrlNumeric(ByVal str As Variant) As Boolean
    If IsNumeric(str) = False Then
        CtrlNumeric = False
    Else
        CtrlNumeric = True
    End If
End Function

Ce qui n'enlève pas le fait de taper le code du TextBox dans les 50 TextBoxes ...

Réponse 2 / 3

benjamin

Bonjour !!
Voici une modficiation que j'ai apporté à mon programme.
Seulement, il est limité. En effet, il commence par verifier l'existence d'une erreur de saisie.
A ce niveau, il verifie si la valeur renseignée dans textbox1, textbox2 et textbox3 est numérique. Or j'ai 50 textbox
Lorsque j'écris
Do While IsNumeric(TextBox1.Text) = False Or IsNumeric(TextBox2.Text) = False Or IsNumeric(TextBox3.Text) = False
Or IsNumeric(TextBox4.Text) = False Or IsNumeric(TextBox5.Text) = False..................................
Il souligne au rouge les lignes à partir desquelles debutent le 3 eme Or
Commence faire ?
Aidez moi s'il vous plait !
Voici l'intégralité de mon programme.

Private Sub CommandButton79_Click()
Application.ScreenUpdating = False
Dim OuvrirAs Variant
Dim ewk as workbook
'modification du chemin par défaut
Do While IsNumeric(TextBox1.Text) = False Or IsNumeric(TextBox2.Text) = False Or IsNumeric(TextBox3.Text) = False
MsgBox "VOUS DEVEZ SAISIR OBLIGATOIREMENT UNE VALEUR NUMERIQUE", vbInformation
Exit Sub
Loop
ChDir ("C:\Users\HP PROBOOK\Desktop\DN BUDGET\DOSSIER DE TRAVAIL")
OuvrirFichiers = Application.GetOpenFilename _
(filefilter:="Classeur Microsoft Excel (*.xls),*.xls,Feuille de Calcul Excel,*.xlsx, PageWeb (*.htm; *.html), *.htm;*.html", _
FilterIndex:=2, _
Title:="BOITE DE DIALOGUE POUR CHOISIR UN FICHIER", MultiSelect:=False)
If Ouvrir= False Then Exit Sub
else
Set ewk = Workbooks.Open(Ouvrir)
End if
Call enreg
End sub

Private sub enreg(byrefewk as workbook)
With ewk.worksheets("Feuil1")
.Cells(1, 1).Value = TextBox1
TextBox1 = ""
.Cells(10, 1).Value = TextBox2
TextBox2 = ""
.Cells(11, 1).Value = TextBox3
TextBox3 = ""
End with
End sub

Réponse 3 / 3

Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention 1 204

Tu as essayé ce que je t'ai donné au lien #1 ?

Ça serait bien d'avoir des retours sur ce qui est proposé.

Sinon, une autre piste.

Dim ctl As Control
Dim i As Integer
Dim TabCtl()
Dim ind As Integer
Dim msg As String

    i = 1
    For Each ctl In Me.Controls
        If ctl.Name = "TextBox" & i Then
            If IsNumeric(ctl.Text) = False Then
                ReDim Preserve TabCtl(ind)
                TabCtl(ind) = ctl.Name
                ind = ind + 1
            End If
            i = i + 1
        End If
    Next ctl
    
    MsgBox UBound(TabCtl()) + 1 & " erreur(s) de saisie"

f894009 Messages postés 17277 Date d'inscription Statut Membre Dernière intervention 1 713

Bonjour Polux31,

fichier avec module de classe cslTxT pour ctrl en temps reel avec le code propose Lien (#1)

https://www.cjoint.com/?DBorKpuhhU4

Polux31 Messages postés 6917 Date d'inscription Statut Membre Dernière intervention 1 204

Salut f894009,

Excellent !!! faut-il encore que ça soit exploité ^^

Discussions similaires

Problème de décodeur TV Bouygues Telecom

SMS message vocal arnaque ?

Votre réponse

Discussions similaires