XL 2010 Quantité transférée

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
H

hema300

XLDnaute Nouveau
Bonjour
Quelqu'un peut-il m'aider s'il vous plaît

Il existe un transfert de formulaire utilisateur1

En raison du grand nombre de catégories, j'ai ajouté listbox1 au formulaire

Lorsque les données sont transférées vers la listbox, cela fonctionne correctement, mais lorsqu'elles sont transférées vers la feuille de calcul, elles n'enregistrent ni ne transfèrent l'inventaire. Il y a une erreur et je n'en connais pas la raison.
 

Pièces jointes

Trier par date Trier par votes
VB: 
Private Sub MajInventaire()
Dim QS&, n&, v
   With Worksheets("Inventaire")
      flgAdd = 0
      n = UBound(TblInv): lgS = 0: lgD = 0
      GetLig ComboBox1, n, lgS: If lgS = 0 Then Exit Sub
      GetLig ComboBox2, n, lgD: If lgD > 0 Then flgAdd = 1
      If lgD = 0 Then
         flgAdd = 0: lgD = n + 3
         If lgD = 65000 Then
            MsgBox "Le tableau en feuille Inventaire est plein !", 48
            lgD = 0: Exit Sub   'on fait rien, et on sort de la sub !
         End If
      End If
      Application.ScreenUpdating = 0: .Unprotect: QT = Val(Quantitetr)

      With .Cells(lgS, 11)  ' était (lgS, 3)
         QS = .Value + QT: .Value = QS: stocktr = QS
      End With
      Application.EnableEvents = False
      .Activate     ' active la feuille

      If flgAdd = 0 Then
      ' insère une ligne
      .Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      .Unprotect
      .Rows("5:5").Copy                         ' copie la ligne en dessous
      .Rows("4:4").PasteSpecial xlPasteFormats  ' colle le format

      .Range("D5").Copy        ' copie la cellule
      .Range("D4").Select      ' sélectionne la cellule
      ActiveSheet.Paste        ' colle (formule incluse)

      Application.EnableEvents = True

      lgD = 4
      End If
For v = 0 To ListBox1.ListCount - 1
      With .Cells(lgD, 3)
         If flgAdd = 0 Then
            .Offset(, -2) = ListBox1.List(v, 3)           'Code article
            .Offset(, -1) = ListBox1.List(v, 4)             'Catégorie
            .Offset(, 2) = ListBox1.List(v, 5)              'Seuil d'alerte
            .Offset(, 3) = ListBox1.List(v, 6)              'Descriptif
            .Offset(, 4) = ListBox1.List(v, 7)               'Référence
            .Offset(, 5) = ListBox1.List(v, 8)              'Unité de mesure
            .Offset(, 6) = "Transfert"         'Observations
            .Offset(, 9) = ComboBox2           'Magasin
            QD = Val(.Value) + QT: .Value = QD   'Stock actuel
         Else
            .Offset(, 7) = .Offset(, 7) + Quantitetr '
         End If
         lgT = lgT + 1

      End With
      .Protect: Application.ScreenUpdating = -1
      Next
   End With

End Sub
Private Sub LigneTransfert()
Dim v
   'remplir une ligne sur le tableau de la feuille "Transfert",
   'mais s'il n'y a plus de ligne libre, on ne fait rien !
   With Worksheets("Transfert")
   'Lastrow = Range("a" & Rows.Count).End(xlUp).Row + 1

      lgT = .Cells(Rows.Count, 1).End(3).Row + 1
      For v = 0 To ListBox1.ListCount - 1

      If lgT = 650000 Then
         MsgBox "Le tableau en feuille Transfert est plein !", 48
         lgT = 0: Exit Sub   'on fait rien, et on sort de la sub !
      End If
      Dim Stock1&, Stock2&
      Application.ScreenUpdating = 0: .Unprotect
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      Stock2 = Val(stocktr): Stock1 = Stock2 + QT
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      With .Cells(lgT, 1)
         .Value = ListBox1.List(v, 1)          'Code article
         .Offset(, 1) = ListBox1.List(v, 2)      'Catégorie
         .Offset(, 2) = ListBox1.List(v, 3)      'Désignation
         .Offset(, 3) = ListBox1.List(v, 4)       'Référence
         ' .Offset(, 4) = ListBox1.List(v, 4)      'Stock actuel
         .Offset(, 5) = ListBox1.List(v, 7)       'Unité
         .Offset(, 6) = Date        'Date
         .Offset(, 7) = ComboBox1   'Provenance
         .Offset(, 8) = ComboBox2   'Destination
         .Offset(, 9) = QT '= ListBox1.List(v, 13)       'Quantité transférée
         '.Offset(, 10) = Stock2     'STOCK PR
         ' .Offset(, 11) = QD         'STOCK DES
         .Offset(, 12) = TextBox1
         .Offset(, 13) = Format(Now, "mm/dd/yyyy hh:mm am/pm")
         lgT = lgT + 1
      End With
      .Protect: Application.ScreenUpdating = -1
      Next
   End With
End Sub
Private Sub UndoOpInv()
   Application.ScreenUpdating = 0
   With Worksheets("Inventaire")
      .Unprotect
      With .Cells(lgS, 3): .Value = .Value + QT: End With
      With .Cells(lgD, 3)
         If flgAdd Then .Offset(, -3).Resize(, 12).ClearContents _
            Else .Value = .Value - QT
      End With
      .Protect
   End With
   Application.ScreenUpdating = -1
End Sub
 
Vote positif 0 Vote négatif
Code: 
Private Sub MajInventaire()
Dim QS&, n&, v
   With Worksheets("Inventaire")
      flgAdd = 0
      n = UBound(TblInv): lgS = 0: lgD = 0
      GetLig ComboBox1, n, lgS: If lgS = 0 Then Exit Sub
      GetLig ComboBox2, n, lgD: If lgD > 0 Then flgAdd = 1
      If lgD = 0 Then
         flgAdd = 0: lgD = n + 3
         If lgD = 65000 Then
            MsgBox "Le tableau en feuille Inventaire est plein !", 48
            lgD = 0: Exit Sub   'on fait rien, et on sort de la sub !
         End If
      End If
      For v = 0 To ListBox1.ListCount - 1

      Application.ScreenUpdating = 0: .Unprotect: ListBox1.List(v, 8) = QT
      With .Cells(lgS, 11)  ' était (lgS, 3)
         QS = .Value + QT: .Value = QS: QS = ListBox1.List(v, 7)
      End With
      Next
      Application.EnableEvents = False
      .Activate     ' active la feuille
      
      If flgAdd = 0 Then
      ' insère une ligne
      .Rows("4:4").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      .Unprotect
      .Rows("5:5").Copy                         ' copie la ligne en dessous
      .Rows("4:4").PasteSpecial xlPasteFormats  ' colle le format

      .Range("D5").Copy        ' copie la cellule
      .Range("D4").Select      ' sélectionne la cellule
      ActiveSheet.Paste        ' colle (formule incluse)

      Application.EnableEvents = True

      lgD = 4
      End If
For v = 0 To ListBox1.ListCount - 1
      With .Cells(lgD, 3)
         If flgAdd = 0 Then
            .Offset(, -2) = ListBox1.List(v, 1)        'Code article
            .Offset(, -1) = ListBox1.List(v, 4)            'Catégorie
             .Offset(, 2) = ListBox1.List(v, 5)           'Seuil d'alerte
            .Offset(, 3) = ListBox1.List(v, 6)             'Descriptif
             .Offset(, 4) = ListBox1.List(v, 7)           'Référence
            .Offset(, 5) = ListBox1.List(v, 8)             'Unité de mesure
             .Offset(, 6) = ComboBox7       'Observations
           .Offset(, 9) = ComboBox2            'Magasin
            QD = Val(.Value) + QT: .Value = QD   'Stock actuel
         Else
             .Offset(, 7) = .Offset(, 7) + ListBox1.List(v, 8)
         End If
         lgT = lgT + 1

      
      End With
      .Protect: Application.ScreenUpdating = -1
      Next
  
   End With
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

H
  • Question Question
XL 2010 listbox Quantité transférée
Réponses
3
Affichages
415
hema300
H
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
288
NONO14
N
M
  • Question Question
Microsoft 365 Erreur de format
Réponses
5
Affichages
457
Marvin57
M
N
  • Question Question
Microsoft 365 Demande aide optimisation planning
Réponses
5
Affichages
2 K
Nicohuss
N
W
  • Résolu(e)
Microsoft 365 Stabilité d'un classeur Excel avec des milliers de noms
Réponses
4
Affichages
1 K
winzek
W
surgeon84fr
  • Question Question
XL 2016 Macro VBA pour créer une BdD à partir de plusieurs fichiers
Réponses
2
Affichages
2 K
surgeon84fr
surgeon84fr
S
  • Question Question
Premier post : déplacer le contenu d'une cellule
Réponses
5
Affichages
2 K
soan
S
Yoyo01000
  • Question Question
XL 2016 Insérer le contenu d'une ListBox dans cellules
Réponses
2
Affichages
1 K
Yoyo01000
Yoyo01000
R
  • Question Question
Microsoft 365 VBA : USERFORM FORMULAIRE
Réponses
6
Affichages
2 K
jpb388
jpb388
J
  • Question Question
contenu textbox dans cellule
Réponses
3
Affichages
2 K
jabenj
J
Y
  • Question Question
XL 2016 macro tarifs degressifs plusieurs catégories
2
Réponses
18
Affichages
2 K
youpi457032
Y
M
  • Question Question
Rdv vers outlook sur calendrier partagé
Réponses
6
Affichages
2 K
MikaTI
M
D
  • Question Question
Private Sub ne fonctionne pas à la création/copie nouvelle page dans multipage
Réponses
1
Affichages
753
camarchepas
camarchepas
S
  • Question Question
Format de date et de nombre
Réponses
6
Affichages
13 K
Sabrina_95
S
M
  • Question Question
drop down list devenu inutilisable
Réponses
7
Affichages
1 K
Maarten
M
W
  • Question Question
[Résolu] Transfert de fichier partiel dans un autre répertoire (choix de feuilles)
2
Réponses
16
Affichages
2 K
Webperegrino
W
A
  • Question Question
Introduire un code VBA dans Excel
Réponses
12
Affichages
2 K
MJ13
MJ13
A
  • Question Question
pb tri lors de transfert listbox à listbox
Réponses
4
Affichages
1 K
antiphot
A
O
  • Question Question
Problèmes VBA - Activation des macros et Macros imbriquées
Réponses
0
Affichages
2 K
olivepao
O
H4MZT3R
  • Question Question
Excel et les listes
2
Réponses
17
Affichages
3 K
H4MZT3R
H4MZT3R
Retour