Gros probleme pour créer ce projet

Kero

Kero

XLDnaute Junior
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.:confused:

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
 
Dernière édition:
Trier par date Trier par votes
skoobi

skoobi

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Kero

Kero

XLDnaute Junior
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".
 
Dernière édition:
Vote positif 0 Vote négatif
Kero

Kero

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

Pièces jointes

  • exemplekero.xls
    43 KB · Affichages: 42
  • exemplekero.xls
    43 KB · Affichages: 41
  • exemplekero.xls
    43 KB · Affichages: 41
Dernière édition:
Vote positif 0 Vote négatif
skoobi

skoobi

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
Kero

Kero

XLDnaute Junior
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
Cliquez pour agrandir...
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
 
Dernière édition:
Vote positif 0 Vote négatif
Kero

Kero

XLDnaute Junior
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 :rolleyes: .
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.
 

Pièces jointes

  • test comparatifXld.zip
    51.9 KB · Affichages: 20
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

R
  • Question
Microsoft 365 Transformer des codes barre en ean13
Réponses
3
Affichages
461
ramemat76
R
S
  • Question
Aide pour un fichier excel d'inventaire avec une douchette.
Réponses
2
Affichages
950
Sokay
S
A
  • Question
XL 2019 Filtre avancé en VBA
Réponses
12
Affichages
592
Amilo
A
G
  • Question
Microsoft 365 Tableau de bord
Réponses
2
Affichages
802
merinos
merinos
G
  • Question
Microsoft 365 Ajouter et supprimer des données sur tableau de bord
Réponses
6
Affichages
669
grace2023
G
E
  • Question
Microsoft 365 effacer formule en fonction de ce qui a été saisi dans une autre cellule
Réponses
6
Affichages
295
Phil69970
Phil69970
C
  • Résolu(e)
Autres code barre dans textbox pour sélectionner ligne a afficher dans listbox
2 3
Réponses
33
Affichages
2 K
herve62
herve62
S
  • Question
XL 2021 Planning de suivi des actions pour service Hygiène Sécurité et Environnement
Réponses
2
Affichages
697
fanfan38
fanfan38
S
  • Question
XL 2019 une aide d'expert pour un code VBA à actualiser
2
Réponses
15
Affichages
958
Sebasto
S
Agecanonix35400
  • Question
XL 2016 Vérification nombre et taille -RESOLU
Réponses
3
Affichages
567
Agecanonix35400
Agecanonix35400

Membres actuellement en ligne

4 membres et 49 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 450
Messages
2 109 731
Membres
110 553
dernier inscrit
loic55