insertion dans LISTBOX des valeurs sur plusieurs lignes d'une autre LISTBOX

fid

XLDnaute Nouveau
bonjour le forum !

j'ai un formulaire qui selon le choix d'un comboboxfeu affiche le détail de la composition de ce feu (d'artifice) dans une listboxArtDes (affichage de la distance, du code art, de la désignation et de la qté)

je peux sélectionner une ligne de cette listboxArtDes, pour modifier la qté, le code article, en sélectionnant ces éléments dans des listboxArticles ou TextboxQté (où je tape la qté désirée)

maintenant, j'ai ajouté une ComboBoxAutreSeq qui propose de nouveaux tableaux

chaque tableau est composé de plusieurs lignes produits qui apparaissent dans une ListBoxProdSeq avec le détail

je voudrais pouvoir insérer la totalité des ces lignes dans la listboxArtDes à l'aide du bouton CmdButInsertAutreSeq

comment dire dans la macro du bouton de rajouter TOUTES les LIGNES de la ListBoxProdSeq ?

Code:
Private Sub CmdButInsertAutreSeq_Click()
'pour insérer une autre séquence avec tous les produits associés, mais ne faisant pas partie du devis type
'=================================================================Application.EnableEvents = False
Application.ScreenUpdating = False

With Sheets("CodesFeux")    Set RgListBoxProdSeq1 = .Range("N2:N" & .Range("N65536").End(xlUp).Row)    Set RgListBoxProdSeq2 = .Range("O2:O" & .Range("O65536").End(xlUp).Row)    Set RgListBoxProdSeq3 = .Range("Q2:Q" & .Range("Q65536").End(xlUp).Row)    Set RgListBoxProdSeq4 = .Range("P2:P" & .Range("P65536").End(xlUp).Row)    Set RgListBoxProdSeq5 = .Range("R2:R" & .Range("R65536").End(xlUp).Row)End WithDim Plg_A_Inserer1 As Range
Dim Plg_A_Inserer2 As Range
Dim Plg_A_Inserer3 As Range
Dim Plg_A_Inserer4 As Range
Dim Plg_A_Inserer5 As Range

'Si l'usager n'a fait aucune sélection
With Me.ListBoxArtDes
  If .ListIndex = -1 Then
    'fin de la procédure
    Exit Sub
  Else
    'récupère la ligne dans la feuille qui correspond
    'à la sélection dans le listboxArtDes
    LigInsert = .ListIndex
  End If
End With

'Récupération des valeurs à insérer
With ListBoxProdSeq
  If .ListIndex <> -1 Then
    Set Plg_A_Inserer1 = RgListBoxProdSeq1(.ListIndex + 1) 'séquence
    Set Plg_A_Inserer2 = RgListBoxProdSeq2(.ListIndex + 1) 'code article
    Set Plg_A_Inserer3 = RgListBoxProdSeq3(.ListIndex + 1) 'qté
    Set Plg_A_Inserer4 = RgListBoxProdSeq4(.ListIndex + 1) 'description art.
    Set Plg_A_Inserer5 = RgListBoxProdSeq5(.ListIndex + 1) 'distance sécurité
  End If
End With


'insertion dans la listboxArtDes au dessus de la ligne sélectionnée du produit sélectionné


Dim lig As Integer, posit As Integer, i As Integer, j As Integer
' i : boucle sur les lignes, j sur les colonnes
   lig = ListBoxArtDes.ListCount 'Nombre de ligne dans la listbox
   posit = ListBoxArtDes.ListIndex
   ListBoxArtDes.AddItem " "
   For i = lig To posit + 1 Step -1
     For j = 0 To 4 ' 5 colonnes (distance Sécurité/fresque/Qté/Code Article/Désignation)
         ListBoxArtDes.List(i, j) = ListBoxArtDes.List(i - 1, j)
        

     Next j
   Next i
   ListBoxArtDes.List(posit, 0) = Plg_A_Inserer5 'distance sécurité
   ListBoxArtDes.List(posit, 1) = Plg_A_Inserer1 'séquence
   ListBoxArtDes.List(posit, 2) = Plg_A_Inserer3 'Qté
   ListBoxArtDes.List(posit, 3) = Plg_A_Inserer2 'Code article
   ListBoxArtDes.List(posit, 4) = Plg_A_Inserer4 'désignation
   

'Ajout des valeurs dans la feuille devis
Sheets("devis").Select

With Sheets("devis") 'copie de la ListBoxArtDes.List complète et mise à jour dans la feuille "devis"
  .Range("B1:F1").Resize(ListBoxArtDes.ListCount) = ListBoxArtDes.List
Dim Derlig As Long
Derlig = .Range("E:E").Find(what:="*", _
          LookIn:=xlValues, _
          searchorder:=xlByRows, _
          searchdirection:=xlPrevious).Row
          
   
  Range("G2:K2").Select
  Selection.AutoFill Destination:=Range("G2:K" & Derlig), Type:=xlFillDefault
  Range("A2").Select
  Selection.Copy
  Range("A3:A" & Derlig).Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
  Range("L2").Select
 End With

Je joins le fichier exemple sur le site cijoint.fr : regarder uniquement la partie NOUVEAU DEVIS sur la feuille MENU pour tester et voir ce qui se passe

Cijoint.fr - Service gratuit de dépôt de fichiers

d'avance merci pour votre aide
 

Discussions similaires

Réponses
7
Affichages
292
Réponses
6
Affichages
202

Statistiques des forums

Discussions
311 737
Messages
2 082 030
Membres
101 876
dernier inscrit
JULIEN21370