XL 2010 Modif Code d'un Bouton

MuscatMimi · 31 Décembre 2020

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 · 31 Décembre 2020

re
oui @Staple1600 mais ou est la bascule ligne 12 ou plus ??

Staple1600 · 31 Décembre 2020

Re

La bascule se fait grâce à ce qu'on peut lire dans le message où j'évoque la cellule B12

patricktoulon · 31 Décembre 2020

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)

MuscatMimi · 31 Décembre 2020

bon les petits loups,merci de vos réponse,je vais tester tout ça demain matin,je vous tiens au jus
bo réveillon, et prenez soin de vous

patricktoulon · 31 Décembre 2020

@Staple1600 oui après relecture j'ai vu un message parlant de B12 mais perso j'aime pas le besoins de mettre une valeur en ligne 12 pour déterminer justement cette ligne comme étant (dans le sujet ici )la ligne minimum
app.max(12,blabla) le détermine valeur ou pas

Staple1600 · 31 Décembre 2020

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]

MuscatMimi · 31 Décembre 2020

bon réveillon a vous tous,je teste tous ça demain
prenez soin de vous

patricktoulon · 31 Décembre 2020

tien parce ce que j'adore ce gif

patricktoulon · 31 Décembre 2020

bon reveillon @vaucluse immo

MuscatMimi · 1 Janvier 2021

Bonjour a tous,Meilleurs vœux

C'est la bataille au codes
Merci a tous,c'est vrai Stapple,il va y avoir une entête en ligne 11,puisque que cela va devenir un bon de Commande

Staple1600 · 1 Janvier 2021

Bonjour le fil

=>vaucluse immo

c'est vrai Stapple,il va y avoir une entête en ligne 11, puisque que cela va devenir un bon de Commande

Voilà, une nouvelle qu'elle est bonne
L'année 2021 commence bien dans le monde d'Excel.

Staple1600 · 1 Janvier 2021

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

patricktoulon · 1 Janvier 2021

bonjour à tous
il y a donc entête c'est donc un tableau structuré
il va falloir peut être penser alors ,a travailler avec un TS et non un range

Staple1600 · 1 Janvier 2021

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 · 1 Janvier 2021

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.

XL 2010 Modif Code d'un Bouton

MuscatMimi

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

MuscatMimi

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

MuscatMimi

XLDnaute Accro

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

MuscatMimi

XLDnaute Accro

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires