XL 2010 Modif Code d'un Bouton

MuscatMimi

XLDnaute Accro
Bonsoir a tout le Forum et joyeuses fêtes a tous

J'a ce Code de D Josserand qui date de 2005,Je désire commencer a valider Les données d'une ligne de ma ListBox a partir de la ligne 12
de ma feuille,et ainsi de suite,j'y arrive pas

VB:
Private Sub CommandButton2_Click()
Dim L As Integer, x As Byte
L = Sheets("Feuil1").Range("B600").End(xlUp).Row + 1 'incrémente données
    With Me.ListBox2
        For x = 0 To .ListCount - 1
            If .Selected(x) = True Then
                'Feuil1.Range("A" & L) = .Column(0, x)
                Feuil1.Range("B" & L) = .Column(0, x)
                Feuil1.Range("C" & L) = .Column(1, x)
                
                L = L + 1
            End If
        Next x
    End With
End Sub

Merci a tous a l'avance,prenez soin de vous
Cordialement
christian
 

patricktoulon

XLDnaute Barbatruc
re
et comme je suis un serial codeur BIO je privilégie le recyclage de méthode
je disais tout a l'heure simplifier l'array pour 2 (ou plus) colonnes
donc
on transfert la ligne entière de la listbox
si multiselect
VB:
For x = 0 To .ListCount - 1
            L = Application.Max(12, Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row + 1)    '12 ou plus!!!!!
            If .Selected(x) Then Feuil1.Range("B" & L).Resize(, .ColumnCount) = Application.Index(.List, x + 1, 0)
        Next x
si selectsingle
VB:
  L = Application.Max(12, Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row + 1)    '12 ou plus!!!!!
Feuil1.Range("B" & L).Resize(, .ColumnCount) = Application.Index(.List, .ListIndex + 1, 0)
;)
 

Staple1600

XLDnaute Barbatruc
Re

=>patrictoulon
[mauvais esprit - karl sort de cette procédure]
Moi, je suis malin (je ne sers pas le Grand Capital ;))
Je fais du ligne par ligne...

(pas de multi-select et tutti quanti)
J'y vais clic par clic
Histoire ne pas travailler trop vite
(déjà que je suis pas payé "bézef")
Néanmoins, puisque je t'ai lu ;)
VB:
'*********Staple1600 2020 (le dernier jour)*********
' avec de bouts de patricktoulon inside ;-)
Dim f As Worksheet
Private Sub CommandButton2_Click()
Set f = Sheets("Feuil1")
With Me.ListBox2: x = .ListIndex: f.Cells(Rows.Count, 2).End(3)(2).Resize(, 2) = Array(.List(x, 0), .List(x, 1)): End With
End Sub
NB: Pour moi, tout tableau digne ce nom a forcément une ligne d'entête (même si bizarrement elle commence en ligne 12)
Evidemmment, on n'est pas obligé de mettre Staple en B12
On peut y mettre: Yec'hed mat !
ou aussi A Momentary Lapse of Reason
Le code fonctionnera également ;)

[/mauvais esprit - karl sort de cette procédure]
 

patricktoulon

XLDnaute Barbatruc
🤣 🤣 🤣 🤣 🤣 🤣
tien parce ce que j'adore ce gif
demo7.gif
 

Staple1600

XLDnaute Barbatruc
Re

Une petite variante du code précédent
(qui semble fonctionner en 2021 comme en 2020 ;))
VB:
Private r As Range
Private Sub CommandButton2_Click()
With Me.ListBox2: x = .ListIndex: r(, 1) = .List(x, 0): r(, 2) = .List(x, 1): End With
End Sub

Private Sub ListBox2_Change()
Set r = Sheets("Feuil1").Cells(Rows.Count, 2).End(3)(2)
End Sub

Private Sub ListBox2_Click()
CommandButton2.Visible = -1
End Sub

Private Sub UserForm_Initialize()
Set s = Sheets("Feuil2")
ListBox2.List = s.Range("B2:C" & s.Cells(Rows.Count, 3).End(3).Row).Value
CommandButton2.Visible = 0
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonjour patricktoulon

=>patricktoulon
Qui dit entête, dit entête
Et qui dit entête, n'a pas forcèment en tête un ListObject
Mais l'entêtant VBA qui colle à nos doigts hante tant nos têtes, que s'entêter sans savoir la nature du tableau finira par nous donner un mal de tête, en fait.
;)
 

job75

XLDnaute Barbatruc
Bonjour vaucluse immo, JM, patricktoulon,

Pour bien commencer l'année sans se prendre la tête :
VB:
Private Sub CommandButton2_Click() 'RAZ
ListBox2.ListIndex = -1
Feuil1.Rows("12:65536").ClearContents
End Sub

Private Sub ListBox2_Click()
Feuil1.[B11:B65536].Find("", , xlValues).Resize(, 2) = Application.Index(ListBox2.List, ListBox2.ListIndex + 1, 0)
End Sub

Private Sub UserForm_Initialize()
ListBox2.List = Feuil2.Range("B2", Feuil2.Range("C65536").End(xlUp)).Value
End Sub
Bonne et heureuse année 2021.
 

Pièces jointes

  • Fichier Essai(1).xlsm
    24.3 KB · Affichages: 13

Statistiques des forums

Discussions
312 074
Messages
2 085 067
Membres
102 770
dernier inscrit
mathieu.lemaitre