code VBA pour afficher un message d'erreur de saisie

Question

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

Polux31 · Answer

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 ...

benjamin · Answer

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

Polux31 · Answer

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"

Code VBA pour afficher un message d'erreur de saisie

3 réponses

Votre réponse

Discussions similaires

Newsletters