Gros probleme pour créer ce projet

Kero · 10 Avril 2008

Comment remplir la ligne du dessous si la condition est rempli?

Bonjour a tout le Forum

Voila je dois réaliser un projet assez complexe pour ma société sur Excel en plusieurs parties.
J’ai recherché pas mal d’aide sur le forum, des tutoriels sur les macros et le VBA mais je ne comprends pas.

Voici la plus grosse partie du projet

Je dois scanner avec une douchette des codes barres sur des produits différents, dans ces codes barre on doit pouvoir dissocier le numéro de lot et la référence mais le problème, les codes barre ne sont pas pareil et pour certain produit il faut scanner 2 code barre pour avoir ces numéros

Exemple pour un produit à 2 codes barre
1ér code barre : +H302CT50940- n° de réf est « CT5094 »
2ème Code barre : +$$90000150518107FM2705-S n° de lot est « 07FM2705 »

Exemple sur un autre produit à 1 code barre
Code barre : ZVS05060ANRG2792201007 n° de réf est « ZVS05060 » et le n° de lot est « ANRG2792 »

Autre exemple de produit à 2 codes barre
1er code barre : EX061001C n° de Réf est EX061001C
2eme code barre : 105844166317091100 n° de lot est « 58441663 »

Autre exemple de produit à 1 code barre
Code barre : 05052791EW040081 n° de réf « EW040081 » n° de lot « 05052791 »

Alors déjà, première question, est ce que cela vous semble possible a faire sur Excel ?

Serai ce plus facile si l’on met une interactivité avant chaque remplissage de ligne ? a savoir y a-t-il 1 ou 2 code barre à scanner ?

Merci d’avance de vos réponses

Kero

skoobi · 20 Mai 2008

Re : Gros probleme pour créer ce projet

Re,

voici une autre proposition qui devrait marcher cette fois:

Code:

Option Explicit

Sub Detec()
Dim X As String, Codebarre As String, lig_suiv As Long, lig_suivb As Long, lig_suivc As Long
X = InputBox("Entrez le code barre")

With Worksheets("Feuil1")
    lig_suiv = .[A7].CurrentRegion.Rows.Count + 7
'    lig_suiv = .Range("A65536").End(xlUp).Row + 1
'    lig_suivb = .Range("B65536").End(xlUp).Row + 1
'    lig_suivc = .Range("C65536").End(xlUp).Row + 1
    If Range("A" & lig_suiv - 1).Value = "" _
      Or Range("B" & lig_suiv - 1).Value = "" _
      Or Range("C" & lig_suiv - 1).Value = "" Then
      MsgBox "La référence, le lot et la quantité ne sont pas tous renseignés, validation stoppé.", vbCritical
      Exit Sub
    End If

    Select Case Len(X)
    Case 12
        Codebarre = X
        .Range("A" & lig_suiv) = Codebarre
    
    Case 14
        If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 7)
        .Range("A" & lig_suiv) = Codebarre
    
    Case 13
        If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 6)
        .Range("A" & lig_suiv) = Codebarre
    
    Case 15
        If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 8)
        .Range("A" & lig_suiv) = Codebarre
    
    Case 16
        .Range("B" & lig_suiv) = Left(X, 8)
        .Range("A" & lig_suiv) = Mid(X, 9, 8)
        .Range("C" & lig_suiv) = 1
        
    Case 17
        If Left(X, 3) = "+$$" Then Codebarre = Mid(X, 8, 8)
        .Range("B" & lig_suiv) = Codebarre
        .Range("C" & lig_suiv) = 1
        
    Case 18
        If IsNumeric(X) = True Then Codebarre = Mid(X, 3, 8)
        .Range("B" & lig_suiv) = Codebarre
        .Range("C" & lig_suiv) = 1
        
    Case 19
        If Left(X, 2) = 10 Then Codebarre = Mid(X, 3, 9)
        .Range("B" & lig_suiv) = Codebarre
        .Range("C" & lig_suiv) = 1
        
    Case 22
        .Range("A" & lig_suiv) = Left(X, 8)
        .Range("B" & lig_suiv) = Mid(X, 9, 8)
        .Range("C" & lig_suiv) = 1
        
    Case 25
        If Left(X, 3) = "+$$" Then Codebarre = Mid(X, 16, 8)
        .Range("B" & lig_suiv) = Codebarre
        .Range("C" & lig_suiv) = 1
    End Select

End With
End Sub

Kero · 21 Mai 2008

Re : Gros probleme pour créer ce projet

Bonjour le forum

Skoobi, je te remercie de te pencher sur ce probleme et j'ai encore essayé avec tes nouvelles modifications et la probleme est que si je commence par mettre une donnée en "A" après il bloque et pareil si je commence par une données en "B".

skoobi · 21 Mai 2008

Re : Gros probleme pour créer ce projet

Re bonjour,

dans ce cas il faut que tu expliques à nouveau ce que tu veux par des exemples car je croyais avoir compris ton problème mais apparement non...

Kero · 22 Mai 2008

Re : Gros probleme pour créer ce projet

Re bonjour

Ok Skoobi je t'explique le probleme.

Donc je rentre un code barre dans "InputBox" et suivant le "Select Case", me met le résultat en "A"(référence) ou en "B"(lot) ("C" se rempli automatiquement avec "B").
Si je rentre un code barre référence et que le code barre lot n'est pas inscrit, le prochain code barre référence ne doit pas etre mis et inversement pour le code barre du lot.
Est ce que je suis clair dans mon explication?
Je remets le fichier exemple que j'avais créer a cet effet.

skoobi · 22 Mai 2008

Re : Gros probleme pour créer ce projet

Re bonjour,

Voici un nouvel essai:

Code:

Option Explicit
Sub Detec()
Dim X As String, Codebarre As String, lig_suiv As Long, lig_suivb As Long, lig_suivc As Long, Lig As Long
Dim lig_suivTab As Long
X = InputBox("Entrez le code barre")
With Worksheets("Feuil1")
    lig_suivTab = .[A7].CurrentRegion.Rows.Count + 7
    lig_suiv = .Range("A65536").End(xlUp).Row + 1
    lig_suivb = .Range("B65536").End(xlUp).Row + 1
    lig_suivc = .Range("C65536").End(xlUp).Row + 1
    
    Select Case Len(X)
    Case 12 To 15
      For Lig = 8 To lig_suiv - 1
        If .Range("A" & Lig).Value <> "" And .Range("B" & Lig).Value = "" Then
          MsgBox "Interdit de mettre une 2eme référence sans n° de lot.", vbCritical
          Exit Sub
        End If
      Next
    Case 17 To 19, 25
      For Lig = 8 To lig_suivb - 1
        If .Range("B" & Lig).Value <> "" And .Range("A" & Lig).Value = "" Then
          MsgBox "Interdit de mettre un 2eme n° de lot sans référence.", vbCritical
          Exit Sub
        End If
      Next
    End Select
    Select Case Len(X)
    Case 12
        Codebarre = X
        .Range("A" & lig_suivTab) = Codebarre
    
    Case 14
        If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 7)
        .Range("A" & lig_suivTab) = Codebarre
    
    Case 13
        If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 6)
        .Range("A" & lig_suivTab) = Codebarre
    
    Case 15
        If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 8)
        .Range("A" & lig_suivTab) = Codebarre
    
    Case 16
        .Range("B" & lig_suivTab) = Left(X, 8)
        .Range("A" & lig_suivTab) = Mid(X, 9, 8)
        .Range("C" & lig_suivTab) = 1
        
    Case 17
        If Left(X, 3) = "+$$" Then Codebarre = Mid(X, 8, 8)
        .Range("B" & lig_suivTab) = Codebarre
        .Range("C" & lig_suivTab) = 1
        
    Case 18
        If IsNumeric(X) = True Then Codebarre = Mid(X, 3, 8)
        .Range("B" & lig_suivTab) = Codebarre
        .Range("C" & lig_suivTab) = 1
        
    Case 19
        If Left(X, 2) = 10 Then Codebarre = Mid(X, 3, 9)
        .Range("B" & lig_suivTab) = Codebarre
        .Range("C" & lig_suivTab) = 1
        
    Case 22
        .Range("A" & lig_suivTab) = Left(X, 8)
        .Range("B" & lig_suivTab) = Mid(X, 9, 8)
        .Range("C" & lig_suivTab) = 1
        
    Case 25
        If Left(X, 3) = "+$$" Then Codebarre = Mid(X, 16, 8)
        .Range("B" & lig_suivTab) = Codebarre
        .Range("C" & lig_suivTab) = 1
    End Select
End With
End Sub

Kero · 22 Mai 2008

Re : Gros probleme pour créer ce projet

Re le forum, Skoobi

Merci beaucoup Skoobi, mais il y avait un autre souci, c'est qu'il sautait une ligne pour "B".
Je m'explique: une fois la référence entrée, je ne peux pas mettre une autre référence(sa c'estok) donc je rentre le lot dans "B" mais sa saute une ligne et après j'etais bloqué. Du coup j'ai remplacer les "lig_suivTab" par "lig_suiv", "lig_suivb" et "lig_suivc" correspondant et la tout fonctionne correctement!!!!!
Ce qui donne :

Sub Detect()
Dim X As String, Codebarre As String, lig_suiv As Long, lig_suivb As Long, lig_suivc As Long, Lig As Long
Dim lig_suivTab As Long
X = InputBox("Entrez le code barre")
With Worksheets("Feuil1")
lig_suivTab = .[A7].CurrentRegion.Rows.Count + 7
lig_suiv = .Range("A65536").End(xlUp).Row + 1
lig_suivb = .Range("B65536").End(xlUp).Row + 1
lig_suivc = .Range("C65536").End(xlUp).Row + 1

Select Case Len(X)
Case 12 To 15
For Lig = 8 To lig_suiv - 1
If .Range("A" & Lig).Value <> "" And .Range("B" & Lig).Value = "" Then
MsgBox "Interdit de mettre une 2eme référence sans n° de lot.", vbCritical
Exit Sub
End If
Next
Case 17 To 19, 25
For Lig = 8 To lig_suivb - 1
If .Range("B" & Lig).Value <> "" And .Range("A" & Lig).Value = "" Then
MsgBox "Interdit de mettre un 2eme n° de lot sans référence.", vbCritical
Exit Sub
End If
Next
End Select
Select Case Len(X)
Case 12
Codebarre = X
.Range("A" & lig_suiv) = Codebarre

Case 14
If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 7)
.Range("A" & lig_suiv) = Codebarre

Case 13
If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 6)
.Range("A" & lig_suiv) = Codebarre

Case 15
If Left(X, 2) = "+H" Then Codebarre = Mid(X, 6, 8)
.Range("A" & lig_suiv) = Codebarre

Case 16
.Range("B" & lig_suivb) = Left(X, 8)
.Range("A" & lig_suiv) = Mid(X, 9, 8)
.Range("C" & lig_suivc) = 1

Case 17
If Left(X, 3) = "+$$" Then Codebarre = Mid(X, 8, 8)
.Range("B" & lig_suivb) = Codebarre
.Range("C" & lig_suivc) = 1

Case 18
If IsNumeric(X) = True Then Codebarre = Mid(X, 3, 8)
.Range("B" & lig_suivb) = Codebarre
.Range("C" & lig_suivc) = 1

Case 19
If Left(X, 2) = 10 Then Codebarre = Mid(X, 3, 9)
.Range("B" & lig_suivb) = Codebarre
.Range("C" & lig_suivc) = 1

Case 22
.Range("A" & lig_suiv) = Left(X, 8)
.Range("B" & lig_suivb) = Mid(X, 9, 8)
.Range("C" & lig_suivc) = 1

Case 25
If Left(X, 3) = "+$$" Then Codebarre = Mid(X, 16, 8)
.Range("B" & lig_suivb) = Codebarre
.Range("C" & lig_suivc) = 1
End Select
End With
End Sub

Je te remercie encore une fois car le projet est terminer a 100% au niveau du vba.

Je finalise le reste et je vous mon projet pour que vous puissiez voir a quoi cela ressemble.

Je remercie aussi toutes les personnes qui ont pu m'aider a ce sujet car j'ai pu lire et recuperer d'autre code qui agremente mon projet.

Cordialement Kero

Kero · 23 Mai 2008

Re : Gros probleme pour créer ce projet [Résolu]

Bonjour a tous!!!!

Voila comme promis je vous mets mon projet terminé et finalisé pour XLD.
Pour ceux qui regardent les macros et voient quelque modification a apporter au projet, je suis preneur a l'améliorer au mieux .
Dans la pièce joint se trouve le projet "Gestion par code barreXld" le fichier de comparaison et un fichier txt avec des code barre à rentrer.

Je remercie toutes les personnes du forum qui apportent de l'aide et prenne du temps a donner des coups de pouce aux personnes qui peine sur Excel.

Gros probleme pour créer ce projet

Kero

XLDnaute Junior

skoobi

XLDnaute Barbatruc

Kero

XLDnaute Junior

skoobi

XLDnaute Barbatruc

Kero

XLDnaute Junior

Pièces jointes

skoobi

XLDnaute Barbatruc

Kero

XLDnaute Junior

Kero

XLDnaute Junior

Pièces jointes

Discussions similaires