Corriger mon code VBA
bonjour le forum, bonjour à tous,
j'ai fait un mix de 2 codes qui ne fait aucun effet, merci de dire ce que j'ai loupé s'il vous plait.
Private Sub CmbB_Emplacement_1_AfterUpdate()
'Str_Emplacement_1 = ""
'If Str_Emplacement_1 = "" Then Exit Sub
VarQte_Stock = 0: VarQte_Compare = 0
Ok_Change = True
With UsF_GESTION 'avec le Userform
With MltiPg.Pages(1) 'Avec la page du Multipage
Str_Magasin_1 = CmbB_Magasins_1.Text
With .CmbB_Emplacement_1
Me.CmbB_Emplacement_1.DropDown
If Me.CmbB_Emplacement_1.ListCount = 1 Then
Me.CmbB_Emplacement_1.ListIndex = 0
MsgBox " Emplacement trouvé"
.TxtB_Quantite_1.SetFocus
ElseIf Me.CmbB_Emplacement_1.ListCount = 0 Then
MsgBox " Emplacement inexistant"
Me.CmbB_Emplacement_1 = Left(Me.CmbB_Emplacement_1, Len(Me.CmbB_Emplacement_1) - 1)
End If
Str_Emplacement_1 = .Text
If Str_Emplacement_1 = "" Then Exit Sub
'Str_Code_Emplacement = .List(.ListIndex, 1)
If Str_Magasin_1 Like "Hors Site E" Then
Str_Code_Emplacement = Search_Ext(Tab_Exterieurs, Str_Emplacement_1)
Else
Str_Code_Emplacement = IIf(Mid(Str_Emplacement_1, 3, 1) = "R", "Rack ", "Sol ") & _
IIf(Len(Mid(Str_Emplacement_1, 3)) = 4, Mid(Str_Emplacement_1, 4, 2) & _
"." & Right(Str_Emplacement_1, 1), Mid(Str_Emplacement_1, 4))
End If
End With
.TxtB_Code_Magasin_1.Text = Str_Code_Emplacement
.TxtB_Quantite_1.SetFocus
End With
End With
End Sub
j'ai ajouté la partie du milieu pris dans un autre fichier avec pour objectif que si je saisis un numéro d'emplacement déjà existant, le msgbos affiche: emplacement inexistant et dans le cas contraire : emplacement trouvé.
merci d'avance pour votre aide.
Moutchec.
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Bonjour
il manque un truc me semble là ==> .text ? <==
Str_Emplacement_1 = .Text
RE : non ne marche pas, ça ne fait aucun effet.
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Re bonjour
Peux tu mettre le fichier en question car là c'est dur de trouver merci
- Messages
- 308
- Excel
- 2016
- Inscrit
- 15/06/2017
- Emploi
- Bénéficiaire de la sécurité de la vieillesse
Bonjour moutchec, bonjour le fil, bonjour le forum,
Je ne comprends pas trop ton besoin.
Mais pour ce que j'en ai compris, voici une suggestion ...
Ne touche pas au contenu de la macro "Private Sub CmbB_Emplacement_1_AfterUpdate()"
Mais ajoute ... en dessous ... disons :
Private Sub CmbB_Emplacement_1_Enter()
Application.SendKeys ("s")
CmbB_Emplacement_1.DropDown
End Sub
À tester ...
Joseph
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Re,
Grâce à Retraite8 en le remerciant ^^ voici le fichier
je t'ai un petit peu arrangé les commentaires sa devenez un peu trop
petite remarque : attention j'ai rencontré dans l'userform des textareas et tu les a nommés lbl... se qui peut porté à confusion par la suite...
re
je crois que je n'ai pas bien expliqué ce que j'espérais.
en fait dans le multipage 1, après avoir entré un nouveau numéro de lot et choisi le magasin de destination, j'ai deux solutions pour entrer le code emplacement dans le textbox : CmbB_Emplacement_1 = menu déroulant ou saisie.
avec le menu déroulant les codes emplacements déjà occupés par un lot sur la feuille stock ne sont pas proposés, cependant si je choisis de saisir le code emplacement tout passe sans problème et ce n'est pas normal.
vu qu'il y a des centaines de codes, je vais plus vite en saisissant, seulement le risque d'erreur est important si les emplacements occupés ne sont pas exclus, d'où l'intérêt du message-box emplacement trouvé lorsque le code emplacement n'existe pas sur la feuille stock et du message-box emplacement inexistant suivi de l'effacement du btextbox lorsque le code emplacement existe déjà sur la feuille stock.
merci à tous pour vos interventions.
Moutchec.
- Messages
- 308
- Excel
- 2016
- Inscrit
- 15/06/2017
- Emploi
- Bénéficiaire de la sécurité de la vieillesse
Bonjour moutchec, bonjour le fil, bonjour le forum,
Espérant avoir bien compris le besoin...
On peut sûrement faire mieux, mais ceci fonctionne.
À tester...
Private Sub CmbB_Emplacement_1_AfterUpdate()
Dim I As Integer
Dim X As Integer
'Str_Emplacement_1 = ""
'If Str_Emplacement_1 = "" Then Exit Sub
VarQte_Stock = 0: VarQte_Compare = 0
Ok_Change = True
With UsF_GESTION 'avec le Userform
With MltiPg.Pages(1) 'Avec la page du Multipage
Str_Magasin_1 = CmbB_Magasins_1.Text
With .CmbB_Emplacement_1
X=0
For I = 0 To (.ListCount - 1)
If .Value = .List(I, 0) Then
X = 1
Exit For
End If
Next I
If X = 0 Or .Value = "" Then
.Value = ""
Application.SendKeys ("+{TAB}")
Exit Sub
End If
If Str_Magasin_1 Like "Hors Site E" Then
Str_Code_Emplacement = Search_Ext(Tab_Exterieurs, Str_Emplacement_1)
Else
Str_Code_Emplacement = IIf(Mid(Str_Emplacement_1, 3, 1) = "R", "Rack ", "Sol ") & _
IIf(Len(Mid(Str_Emplacement_1, 3)) = 4, Mid(Str_Emplacement_1, 4, 2) & _
"." & Right(Str_Emplacement_1, 1), Mid(Str_Emplacement_1, 4))
End If
End With
.TxtB_Code_Magasin_1.Text = Str_Code_Emplacement
.TxtB_Quantite_1.SetFocus
End With
End With
End Sub
Joseph
Bonjour le forum,
bonjour Mr Joseph,
vous avez bien compris ce que je cherche à faire mais il y a deux soucis.
1/ le txtbox emplacement 1 (qui dépend du code emplacement 1) ne se remplit plus avec la bonne information
2/ la touche "num-lock" de mon clavier est systématiquement désactivée.
merci bcp.
amicalement.
Moutchec.
- Messages
- 2'415
- Excel
- 2019
- Inscrit
- 13/07/2017
- Emploi
- Formateur, animateur,tech.informatique
Bonjour Moutchec
peux-tu s'il te plaît remettre le fichier pour savoir les news modifications effectuées merci.
- Messages
- 308
- Excel
- 2016
- Inscrit
- 15/06/2017
- Emploi
- Bénéficiaire de la sécurité de la vieillesse
Bonjour moutchec, bonjour le fil, bonjour le forum,
Si j'ai bien compris ...
Tu as mentionné que pour la rapidité tu préfères saisir le numéro du "Code Magasin 1" et que si c'est un code qu'il y a dans la liste du combobox = tout est bon. Mais si tu fais une faute de frappe, le code entré doit être rejeté.
Je crois y être arrivé.
Pour aviser que le code saisi est erroné, j'ai ajouté un Beep. Pour ce faire, il faut ajouter une déclaration publique, disons dans le module1 ... Declare Function Beep Lib "kernel32" (ByVal Frequence As Long, ByVal Duree As Long) As Long
Puis le code de ces deux macros à tester si ça convient. Entre autres, est-ce que la valeurs "TxtB_Code_Magasin_1" sera la bonne ?
Private Sub CmbB_Emplacement_1_AfterUpdate()
'Str_Emplacement_1 = ""
'If Str_Emplacement_1 = "" Then Exit Sub
VarQte_Stock = 0: VarQte_Compare = 0
Ok_Change = True
With UsF_GESTION 'avec le Userform
With MltiPg.Pages(1) 'Avec la page du Multipage
Str_Magasin_1 = .CmbB_Magasins_1.Text
With .CmbB_Emplacement_1
Str_Emplacement_1 = .Text
If Str_Emplacement_1 = "" Then Exit Sub
If Str_Magasin_1 Like "Hors Site E" Then
Str_Code_Emplacement = Search_Ext(Tab_Exterieurs, Str_Emplacement_1)
Else
Str_Code_Emplacement = IIf(Mid(Str_Emplacement_1, 3, 1) = "R", "Rack ", "Sol ") & _
IIf(Len(Mid(Str_Emplacement_1, 3)) = 4, Mid(Str_Emplacement_1, 4, 2) & _
"." & Right(Str_Emplacement_1, 1), Mid(Str_Emplacement_1, 4))
End If
End With
.TxtB_Code_Magasin_1.Text = Str_Code_Emplacement
.TxtB_Quantite_1.SetFocus
End With
End With
End Sub
Private Sub CmbB_Emplacement_1_Change()
Dim X As Integer
Dim i As Integer
With CmbB_Emplacement_1
X = 0
For i = 0 To (.ListCount - 1)
If .Value = .List(i, 0) Then
X = 1
Exit For
End If
Next i
If X = 0 Then
.Value = ""
.SetFocus
Call Beep(800, 40)
Exit Sub
End If
End With
End Sub
Joseph
bonsoir Mr Joseph, ça marche du tonnerre! vous aurez été mon sauveur dans cette affaire.
mes sincères remerciements.
juste une chose j'arrive pas à ajouter le code dans le module 1.
j'ai écrit comme ceci
public function ....+le code pour le bip
end sub
- Messages
- 308
- Excel
- 2016
- Inscrit
- 15/06/2017
- Emploi
- Bénéficiaire de la sécurité de la vieillesse
Bonjour,
Le code exact est :
Declare Function Beep Lib "kernel32" (ByVal Frequence As Long, ByVal Duree As Long) As Long
Il faut qu'il soit en haut de toute macro et en dessous de Option Explicit ... dans un module. J'ai choisi 1 car, il est presque vide.
Je crois que dans la page Transfert, il y aura aussi à améliorer pour enlever les Application.sendkeys...
Une combinaison de Change et AfterUpdate serait, là aussi, bénéfique.
Concernant le Beep, le premier chiffre est la tonalité, plus le chiffre est grand pour le son est aiguë et le deuxième chiffre est la durée, plus le chiffre est petit plus le son est court.
Joseph
c'est clair qu'il y a des améliorations à apporter dans le fichier et je chipote dessus tout le temps mais je suis assez limité en VBA.
une chose que j'aimerais bien améliorer aussi c'est dans le multipage 2, apport en quantité. faire en sorte que la quantité du mag 1 + l'apport soit inférieur ou égal au volume déclaré du stock.
ex: volume du stock= 25000
qté en stock = 15000
apport = chiffre inférieur ou égal à 10000
donc si 15000 saisi par ex la macro ramène automatiquement le chiffre à 10000.
en tous cas merci pour votre intervention.
amicalement.
Moutchec
Private Sub TxtB_Quantite_ES_1_Change()
On Error Resume Next
If Ok_Change = False Then Ok_Change = True: Exit Sub 'on quitte selon la valeur de OK_Change
With UsF_GESTION 'avec le Userform
With MltiPg.Pages(2).Frm_Operations 'Avec la page du Multipage
With .TxtB_Quantite_ES_1 'Avec le TextBox
VarQte_Compare_10 = IIf(CLng(.Value) = VarQte_Stock_1, VarQte_Stock_1, CLng(.Value)) 'On définit sa valeur en fonction de la variable "VarQte_Stock_1"
'pour eviter d'entrer plus que ce qu'est la valeur en Stock
.Value = IIf(.Value = "", 0, VarQte_Compare_10) 'Idem
.BackColor = IIf(VarQte_Compare_10 = 0, &H8080FF, &H80FF80) 'On colore le fond du controls en fonction de la variable "VarQte_Compare_10"
End With
With .CmdB_Tranferer 'Avec le Combobox
.Visible = IIf(VarQte_Compare_10 = 0, False, True) 'On affiche selon valeur de la Variable
.SetFocus 'on prend le Focus
End With
With .Lbl_Stock_1 'Avec le label
Select Case True 'selon la variable qui est à True
Case VarQteMoins 'ci c'est un prélévement
.Caption = IIf(VarQte_Compare_10 = 0, .Tag, (VarQte_Stock_1 - VarQte_Compare_10)) 'On affiche le resultat en fonction de la variable "VarQte_Compare_10"
VarQte_Stock_Restante_1 = CLng(.Caption) 'On initialise la Variable
Case VarQtePlus 'ci c'est un Ajout
.Caption = IIf(VarQte_Compare_10 = 0, .Tag, (VarQte_Stock_1 + VarQte_Compare_10)) 'On affiche le resultat en fonction de la variable "VarQte_Compare_10"
VarQte_Stock_Restante_1 = CLng(.Caption) 'On initialise la Variable
End Select
End With
End With
End With
On Error GoTo 0
End Sub