none
Insertion des valeurs d'une listbox dans une autre listbox RRS feed

  • Question

  • 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 ?

    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 With
    Dim 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
    

    d'avance merci pour votre aide
     


    FiDSDF
    vendredi 1 avril 2011 15:36

Réponses