Demande d'aide pour modifier code Userform

Version imprimable

1 pièce(s) jointe(s)

bonjour le forum,
bonjour à tous,
je cale depuis qlq jours sur une amélioration que je souhaite apporter à ce fichier trouvé sur le net (merci au passage au concepteur) , raison pour laquelle, je me tourne vers vous.
il s'agit du multipage 4 = transferts (code ci après).
dans l'emplacement cible, il ne propose que les emplacements non présents sur la feuille stock, ce qui est parfait.
ce que j'aimerais c'est que si je choisis un magasin cible et que le lot y existe dans un emplacement, que ce emplacement soit aussi proposé (en plus).
exemple : si je veux faire un transfert du lot 110000 qui est en EMP02, je voudrais que si je choisis le magasin Hall A, alors j'ai les emplacements non occupés (ce qui est le cas) et en plus SAR02C qui est certes occupé mais avec le même lot, histoire d'avoir la possibilité de regrouper des lots (si ça devient le cas physiquement).
merci d'avance.
cordialement.
Pedro Dudesson.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Private Sub CmbB_Emplacement_C_AfterUpdate()
If Ok = False Then Exit Sub
Str_Emplacement_C = "": Str_Code_Emplacement = ""
With UsF_GESTION 'avec le Userform
    With MltiPg.Pages(4) 'Avec la page du Multipage
        Str_Magasin = .CmbB_Transfert_C.Text
        With .CmbB_Emplacement_C
            Str_Emplacement_C = .Text
            .BackColor = IIf(Str_Emplacement_C = "", &H8080FF, &H80FF80)
            If Str_Emplacement_C = "" Then GoTo suite
 
            If Str_Magasin Like "Hors Site E" Then
                Str_Code_Emplacement = Search_Ext(Tab_Exterieurs, Str_Emplacement_C)
            Else
                Str_Code_Emplacement = IIf(Mid(Str_Emplacement_C, 3, 1) = "R", "Rack ", "Sol ") & _
                IIf(Len(Mid(Str_Emplacement_C, 3)) = 4, Mid(Str_Emplacement_C, 4, 2) & _
                "." & Right(Str_Emplacement_C, 1), Mid(Str_Emplacement_C, 4))
            End If
        End With
        suite:
        With .Lbl_Code_Magasin_C
            .Caption = Str_Code_Emplacement
        End With
        With .TxtB_Quantite_C
            .Value = 0
            .BackColor = &H8080FF
            .Enabled = True
        End With
        .TxtB_Commentaire_Transfert_S.Text = "TRANSF-VERS " & .CmbB_Emplacement_C.Text & " " & _
        " (" & "SORTIE" & " " & TxtB_Quantite_C.Value & ")"
    End With
End With
End Sub
 
 
Private Sub CmbB_Emplacement_C_Change()
Dim x As Integer
Dim i As Integer
With CmbB_Emplacement_C
    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 = ""
        Exit Sub
    End If
End With
End Sub

30/05/2019, 17h35
EricDgn

Bonjour,

Je n'ai pas la solution, mais l'endroit qu'il faut compléter est au niveau de la fonction

Code:

Public Function Recup_Emplacement_Occupes(ByVal StrMagasin As String) As String

qui devrait aussi prendre en compte le libellé du lot, et donc être de la forme:

Code:

Public Function Recup_Emplacement_Occupes(ByVal StrMagasin As String, ByVal sLot as String) As String

Un emplacement occupé par le même lot ne devrait pas être listé comme "occupé".
Bonne continuation.
30/05/2019, 18h04
dudesson

bonjour,
je ne l'avais pas vu, merci pour le tuyau.
je m'y mets de suite en espérant en même temps une solution.
sincères salutations.
Pedro.

bonjour le forum,
bonjour à tous,
toutes mes tentatives sont restées vaines mais j'ai une piste qui, je crois, devrait fonctionner mais j'ai du mal à l'écrire en langage vba :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Private Sub CmbB_Emplacement_C_Change()
Dim x As Integer
Dim i As Integer
With CmbB_Emplacement_C
    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
if  le lot en CmbB_Num_Lot_Transfert a sur la feuille Stocks en colonne F le même code magasin que  CmbB_Magasin_C Then
CmbB_Empllacement_C affiche l'emplacement correspondant sur la feuille Stocks en colonne E (cet affichage doit être d'office sélectionné et modifiable)
Else           
 .Value = ""
            Exit Sub
        End If
End With
End Sub

merci d'avance pour votre aide.
Pedro.

01/06/2019, 07h09
Pierre Fauconnier

Salut.

Il faudrait demander au concepteur. Perso, je ne touche pas à un code qui contient des goto, des exit, des with...End With sur trois niveaux, du hard coding, et qui code du métier dans des évènements de userform. Dans un code comme celui-là, tu touches à un truc à un moment donné et tout va s'écrouler. :(
01/06/2019, 10h25
dudesson

Citation:

Envoyé par Pierre Fauconnier

Salut.

Il faudrait demander au concepteur. Perso, je ne touche pas à un code qui contient des goto, des exit, des with...End With sur trois niveaux, du hard coding, et qui code du métier dans des évènements de userform. Dans un code comme celui-là, tu touches à un truc à un moment donné et tout va s'écrouler. :(

bonjour, je pense aussi que c'est du "hard coding" comme vous écrivez mais il n'y a aucun risque à essayer de l'adapter de l'améliorer... j'ai moi même modifié des choses, des fois avec des aides....lorsque ça ne fonctionne pas, hop à la corbeille puisque c'est sur des fichiers exemple. ç'aurait été plus simple en effet de faire modifier par le concepteur, mais encore faudrait-il savoir qui est ce génial développeur!
merci.
Pedro Dudesson.
01/06/2019, 13h29
Pierre Fauconnier

Ce que je veux dire, c'est que tu peux faire ce que tu veux, ce ne sera jamais que des rustines sur des tuyaux percés. J'ai regardé le code, il y a plein de problèmes dedans.

Tu as un on error resume next sans aucun traitement de l'erreur, avec un on error goto 0 en fin de proc qui ne sert à rien (la gestion d'erreurs est toujours limité à une proc. C'est hardcodé dans tous les sens. Aucune architecture ne se dégage de l'ensemble. Une grosse partie du code est placée dans le usf avec un couplage extrêmement fort aux feuilles de données. De sorte que la moindre modif dans une feuille va faire s'écrouler le château de cartes. C'est bourré de variables globales qui empêchent de tester des petits bouts de code. L'organisation des données (déroulants, par exemple) est déroutante. On n'utilise pas les tables de données qui allègeraient considérablement le code tout en le sécurisant et en le rendant plus solide...

Dès lors, la moindre modif de code amenée par quelqu'un qui n'a pas son diplôme de plombier peut avoir des conséquences fâcheuses sur le reste de "l'application".

Faut pas le prendre mal, il n'y a pas d'attaque personnelle. Mais le constat technique est sans appel.

Bonjour,

Effectivement, cette application n'est pas un modèle de clarté. Mais bon, c'est en forgeant que l'on devient progressivement forgeron ... et effectivement, on apprend plus vite quand on prend le temps de bien regarder comment procèdent les meilleurs.

Pour le problème posé, ma proposition: ajouter cette fonction

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Public Function Recup_Emplacement_Occupes_Lot(sMagasin As String, sLot As String) As String
    Dim sEmplacements As String
    sEmplacements = ""
    Tab_Stocks = Recup_Stocks(Ws_Cible_S)   'récupére le Tableau des Données de la Feuille "Stocks"
    For L = 1 To UBound(Tab_Stocks, 1)      'Pour chaque ligne du tableau des Stocks
        If sMagasin = Tab_Stocks(L, 6) Then
            '--- sMagasin est indiqué sur la ligne L traitée --- est donc occupé
            If sLot = Tab_Stocks(L, 3) Then
                '--- c'est le même lot, donc considéré comme "non occupé"
            Else
                '--- le magasin contient un aure lot, donc à déclarer "occupé"
                sEmplacements = sEmplacements & ";" & Tab_Stocks(L, 5) 'ajoute cet emplacement
            End If
        End If
    Next L
    Recup_Emplacement_Occupes_Lot = sEmplacements
End Function

et l'utiliser dans la routine

Code:

1
2
3
4
Private Sub CmbB_Transfert_C_Change()
...
            t = Recup_Emplacement_Occupes_Lot(Str_Magasin, CmbB_Num_Lot_Transfert)
...

sachant que la fonction Recup_Emplacement_Occupes() est encore utilisée à plusieurs autres endroits de l'application. Je n'ai pas regardé si à ces endroits elle doit aussi prendre compte du lot.

Bonne continuation.

Juste pour info, la sub CmbB_Transfert_C_Change écrite un peu plus proprement (sans m'occuper vraiment de la logique):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Private Sub CmbB_Transfert_C_Change()
    If Ok = False Then Exit Sub         '==== EXIT SUB ====
    t = ""
    With Me.CmbB_Transfert_C
        Str_Magasin = .Text
        .BackColor = IIf(Str_Magasin = "", &H8080FF, &H80000005)
    End With
    '*******************
    t = Recup_Emplacement_Occupes(Str_Magasin, CmbB_Num_Lot_Transfert)
    'Debug.Print t
    '*******************
    With Me.CmbB_Emplacement_C
        .Clear
        For Col = 1 To UBound(Tab_Deroulants, 2)
            If Tab_Deroulants(1, Col) Like "Emplacement " & Str_Magasin Then
                ID_Col = Col
                For L = 2 To UBound(Tab_Deroulants, 1)
                    Str_Code_Magasin = Tab_Deroulants(L, ID_Col)
                    If Str_Code_Magasin <> "" And InStr(1, t, Str_Code_Magasin) = 0 Then
                        .AddItem Tab_Deroulants(L, ID_Col)
                        .List(.ListCount - 1, 1) = ""
                    End If
                Next L
                .ListIndex = IIf(.ListCount = 1, 0, -1)
                .BackColor = IIf(.Text = "", &H8080FF, &H80FF80)
                Exit For                '--- EXIT FOR ---
            End If
        Next Col
    End With
    Me.Lbl_Code_Magasin_C.Caption = ""
    With Me.TxtB_Quantite_C
        .Value = 0
        .BackColor = IIf(.Text = 0, &H8080FF, &H80FF80)
    End With
End Sub

02/06/2019, 10h49
dudesson

Merci beaucoup @EricDgn, je commence à tester de suite. Bon dimanche.

bonjour, encore merci @EricDgn, ça marche bien et les autres fonctions aussi. la recup_lot n'est nécessaire que pour les transferts, le but étant de pouvoir regrouper des lots via l'Userform si physiquement c'est le cas.
il y a une modif à laquelle je n'avais pas pensé qui est à faire dans : Private Sub CmdB_Tranferer_Click() dans la partie With Worksheets("Stocks").
en fait, le regroupement donne 2 lignes du lot avec le même emplacement sur la feuille Stocks.
ce qu'il faudrait, c'est que dans ce cas, que la quantité cible vienne s'ajouter à la quantité source.
j'ai ajouté ceci mais ça ne donne pas le résultat attendu :
Code:

1 2 3 4 If VarQte_S > 0 And Str_Emplacement_S = Str_Emplacement_C Then .Cells(NumLigne_1, 8) = VarQte_S + CLng(VarQte_C) .Cells(NumLigne_1, 9) = CDate(TxtB_Date_Transfert) .Cells(NumLigne_1, 10) = Str_Comment_C
merci.
Pedro.

Bonjour,

Une solution pour la partie With Worksheets("Stocks"):

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
    With Worksheets("Stocks")
        If CLng(VarQte_S) > 0 Then
            .Cells(NumLigne_1, 8) = CLng(VarQte_S)                         'QUANTITE
            .Cells(NumLigne_1, 9) = CDate(TxtB_Date_Transfert)             'DATE DERNIER MOUVEMENT
            .Cells(NumLigne_1, 10) = UCase(Str_Comment_S)                  'COMMENTAIRE
        ElseIf CLng(VarQte_S) = 0 Then
            .Cells(NumLigne_1, 1).EntireRow.Delete
        End If
        If CLng(VarQte_C) > 0 Then
            Dim r As Range
            '--- suppose qu'il n'y a AUCUN DOUBLON de Code Magasin
            Set r = .Columns(5).Find(What:=Str_Emplacement_C, After:=.Range("E3"))
            If r Is Nothing Then
                '--- nouvel emplacement
                NumLigne_2 = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(NumLigne_2, 8) = CLng(VarQte_C)                           'QUANTITE
            Else
                '--- emplacement complété
                NumLigne_2 = r.Row
                .Cells(NumLigne_2, 8) = .Cells(NumLigne_2, 8) + CLng(VarQte_C)   'QUANTITE
            End If
            Set r = Nothing
            .Cells(NumLigne_2, 1) = Str_Code_Produit                             'CODE PRODUIT
            .Cells(NumLigne_2, 2) = Str_Nom_Produit                              'NOM PRODUIT
            .Cells(NumLigne_2, 3) = NumLot                                       'LOT
            .Cells(NumLigne_2, 4) = Str_Type_Produit                             'TYPE PRODUIT
            .Cells(NumLigne_2, 5) = Str_Emplacement_C                            'CODE MAGASIN
            .Cells(NumLigne_2, 6) = Str_Magasin_2                                'MAGASIN
            .Cells(NumLigne_2, 7) = Var_Code_Magasin_C                           'EMPLACEMENT
            .Cells(NumLigne_2, 9) = CDate(TxtB_Date_Transfert)                   'Format(CLng(VarDate), "dd/mm/yyyy")          'DATE DU MOUVEMENT
            .Cells(NumLigne_2, 10) = Str_Comment_C                               'COMMENTAIRE
            .Cells(NumLigne_2, 11) = Volume_Stock                                'VOLUME DU STOCK
        End If
    End With

Bonne continuation.

02/06/2019, 20h48
dudesson

bonjour EricDgn,
vous êtes tout simplement parfait.
merci, c'est exactement ce que je voulais.
sincères salutations.
Pedro Dudesson.