Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 userform base de donnée

Paillou

XLDnaute Nouveau
Bonjour,

Novice en VBA j'ai besoin d'aide pour affiner un code.

j'ai un userform, permettant d'obtenir des données d'un tableau. Il faut juste saisir UF (colonne A) dans le textbox1, et ca m'affiche la colonne B et C (dans le textbox 2 & textbox 3)

Ce code fonctionne, cependant si l'utilisateur saisie une UF inferieur à 500 ml ou supérieure à 6 500 ml, donnée indisponible dans le tableau, ca bug et le msgbox ne fonctionne pas.
Comment y remédier ?

De plus, la saisie n'est pas précise 1501 ou lieu 1500, ca bug.
Comment faire pour arrondir la saisie ?

voici le code :

VB:
Private Sub TextBox1_AfterUpdate()

If WorksheetFunction.CountIf(Sheets("BVM BDX").Range("a:a"), Me.TextBox1.Value) < 500 And WorksheetFunction.CountIf(Sheets("BVM BDX").Range("a:a"), Me.TextBox1.Value) > 6500 Then
MsgBox "UF minimum 500 ml ou inférieur 6 500 ml", vbInformation + vbOKOnly, "UFC IMPOSSIBLE"

End If

With Me

.TextBox2 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox1), Sheets("BVM BDX").Range("BVM"), 2, 0)
.TextBox3 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox1), Sheets("BVM BDX").Range("BVM"), 3, 0)

End With

End Sub


merci d'avance
 

Pièces jointes

  • BVM BDX VBA.xlsm
    30.6 KB · Affichages: 2

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Paillou,
Comme le tableau est rempli de nombre, il faut toujours traiter avec Clng(Textbox) même dans les CountIf.
Ensuite les Countif vont donner si la valeur existe, donc non pas <500 et >6500 mais seulement >0.
Pour finir ce n'est pas un ET mais un OU.
Pour essai :
VB:
Private Sub TextBox1_AfterUpdate()
If WorksheetFunction.CountIf(Sheets("BVM BDX").Range("a:a"), CLng(Me.TextBox1.Value)) = 0 Or WorksheetFunction.CountIf(Sheets("BVM BDX").Range("a:a"), CLng(Me.TextBox1.Value)) = 0 Then
    MsgBox "UF minimum 500 ml ou inférieur 6 500 ml", vbInformation + vbOKOnly, "UFC IMPOSSIBLE"
Else
    With Me
        .TextBox2 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox1), Sheets("BVM BDX").Range("BVM"), 2, 0)
        .TextBox3 = Application.WorksheetFunction.VLookup(CLng(Me.TextBox1), Sheets("BVM BDX").Range("BVM"), 3, 0)
    End With
End If
End Sub
 

Pièces jointes

  • BVM BDX VBA.xlsm
    20.6 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
Oups! J'ai zappé le second point, il suffit de rajouter :
VB:
Me.TextBox1.Value = 100 * Int(CLng(Me.TextBox1.Value) / 100)
On arrondi la valeur à la centaine inférieure avant de faire le calcul. Ainsi si on tape 1501, il arrondit à 1500.
 

Pièces jointes

  • BVM BDX VBA V2.xlsm
    20.9 KB · Affichages: 1

sylvanu

XLDnaute Barbatruc
Supporter XLD
... et par pur perfectionnisme, il est inutile de regarder dans la base si le produit existe il suffit de tester son volume si <500 ou >6500.
et ça simplifie le code :
VB:
Private Sub TextBox1_AfterUpdate()
V = 100 * Int(CLng(Me.TextBox1.Value) / 100): Me.TextBox1.Value = V ' V volume entrée dans Textbox1 arrondi à la centaine
If V < 500 Or V > 6500 Then
    MsgBox "UF minimum 500 ml ou inférieur 6 500 ml", vbInformation + vbOKOnly, "UFC IMPOSSIBLE"
    Me.TextBox1.Value = ""
Else
    With Me
        .TextBox2 = Application.WorksheetFunction.VLookup(V, Sheets("BVM BDX").Range("BVM"), 2, 0)
        .TextBox3 = Application.WorksheetFunction.VLookup(V, Sheets("BVM BDX").Range("BVM"), 3, 0)
    End With
End If
End Sub
J'arrête là !
 

Pièces jointes

  • BVM BDX VBA V3.xlsm
    23 KB · Affichages: 11

Discussions similaires

Réponses
9
Affichages
1 K
Réponses
1
Affichages
939
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…