VBA - Transfert d'une listebox à une autre avec mise à jour des tableaux sur la feuille

piga25

XLDnaute Barbatruc
Bonjour,
Poursuivant l'élaboration de mon fichier, je me retrouve avec un nouveau problème.
J'ai bien trouvé un très gros début de solution sur le site de M Boisgontier Jacques; mais après de nombreux essais je n'y arrive pas.
J'aimerai que lorsque l'on active un optionButton que cela indique à la listebox de prendre une certaine base et ainsi de suite.
Le résultat attendu est mieux expliqué sur le fichier joint.
En vous remerciant
 

Pièces jointes

  • TransfertcolonnesMultiSelection.xls
    107 KB · Affichages: 18

piga25

XLDnaute Barbatruc
Bonsoir le Forum
Après recherches, je pense avoir trouvé. En plus il n'y avait pas une erreur mais deux.
VB:
Private Sub B_enlève_Click()
    If Me.Dest.ListIndex <> -1 And Me.Dest.ListCount > 0 Then
    For i = 0 To Me.Dest.ListCount - 1
    If Me.Dest.Selected(i) = True Then
        Me.Source.AddItem Me.Dest.List(i)
        pos = Me.Source.ListCount - 1
        Me.Source.List(pos, 1) = Me.Dest.List(i, 1)
      '---histo
        Me.Historique.AddItem Me.Dest.List(i)
        posh = Me.Historique.ListCount - 1
        Me.Historique.List(posh, 1) = Me.Dest.List(i, 1)
        Me.Historique.List(posh, 2) = Me.Destination.Caption
        Me.Historique.List(posh, 3) = Format(Now, "hh:mm le dd/mm/yyyy")
        '---Main courante
        Me.Main.AddItem Me.Dest.List(i) ' bug lorsque l'on clique une seconde fois dans le cas Retour PC
        posh = Me.Main.ListCount - 1
        Me.Main.List(posh, 0) = Me.Dest.List(i, 1)
        Me.Main.List(posh, 1) = Me.Destination.Caption
        Me.Main.List(posh, 2) = Format(Now, "hh:mm le dd/mm/yyyy")
    End If
        Next i
    'For j = Me.Dest.ListCount - 1 To 0 Step -1
      'If Me.Dest.Selected(j) = True Then Me.Dest.RemoveItem (j)
    'Next j
    If Me.Dest.ListCount > 0 And Me.Dest.ListIndex <> -1 Then Me.Dest.RemoveItem Me.Dest.ListIndex
  End If
  B_transfert_Click
  B_Histo_Click
  B_Main_Click

La première venait d'une erreur de listbox :
'---Main courante
Me.Main.AddItem Me.Source.List(i) -- Ici pas la bonne listbox.
Me.Main.AddItem Me.Dest.List(i) - Ici correct.
La seconde c'est lorsque l'on fait un décrément dans la listbox.
J'ai remplacé :
'For j = Me.Dest.ListCount - 1 To 0 Step -1
'If Me.Dest.Selected(j) = True Then Me.Dest.RemoveItem (j)
'Next j
par : If Me.Dest.ListCount > 0 And Me.Dest.ListIndex <> -1 Then Me.Dest.RemoveItem Me.Dest.ListIndex

Il me reste juste ceci à faire, transférer toutes les lignes de la listbox MAIN dans une textbox située dans un autre userform.
 

piga25

XLDnaute Barbatruc
Bonjour le forum

J'ai trouvé pour mon dernier problème, il suffisait de concaténer dans une seule cellule et de copier cette cellule dans le textbox multiligne.
Je met le fichier complet pour ceux que cela pourrait intéresser.

VB:
Sub Concatene()
Dim Cel As Range, Co As Range
Dim Lg, i As Long
Application.ScreenUpdating = False
k = [S1]
    If k > 0 Then
        For i = 2 To k + 1
            Range("O" & i).Select
            ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[3],"" de "",RC[2],"" à "",RC[4])"
        Next i
    End If
Lg = [O65536].End(xlUp).Row
    With Range("N1")
      .ClearContents
           For Each Cel In Range("O2:O" & Lg)
              If Cel <> "" Then
                .Value = .Value & Cel.Value & Chr(10)
              Else: Exit For
              End If
           Next Cel
    End With
End Sub
 

Pièces jointes

  • Transfert v3.xls
    161.5 KB · Affichages: 23

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa