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.

Bonjour

il manque un truc me semble là ==> .text ? <==

Str_Emplacement_1 = .Text

RE : non ne marche pas, ça ne fait aucun effet.

Re bonjour

Peux tu mettre le fichier en question car là c'est dur de trouver merci

RE : voici

multipage 1 de l'userform : txtbox_emplacement_1.

13copie-de-stocknv.xlsm (188.17 Ko)

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

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

16stocknv-000.xlsm (192.18 Ko)

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.

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.

Bonjour Moutchec

peux-tu s'il te plaît remettre le fichier pour savoir les news modifications effectuées merci.

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

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

Rechercher des sujets similaires à "corriger mon code vba"