ListBox

[Jarodxxx]

Hallo,

Een korte vraag:

"kun je ook gegevens kopieren uit een listbox (formulier)?"

en hoe doe ik dit?

 

[danny147]

Beste Jarodxxx

Wil je de gegevens in je formulier plaatsen en die dan laten wegschrijven naar een bepaalde cel, is dat wat je zou willen

Kun je soms een bestandje meesturen, zeg zoveel meer dan woorden

Groetjes Danny :thumb:

 

[Jarodxxx]

Gegevens ophalen uit een listbox

Bedankt!

Nee, hij haalt gegevens op, deze laat hij zien in de listbox in de vorm van kolommen.

Ik wil alleen ook die informatie kunnen kopieren uit die listbox naar bv excel ofzo.

Groeten

 

[Withaar]

Ik ben/was ook bezig met formuliere en listboxen, misschien heb je hier iets aan;
http://www.helpmij.nl/forum/showthread.php?t=292556&highlight=withaar
of direct naar het bericht met de laatste dowload; http://www.helpmij.nl/forum/showpost.php?p=1926545&postcount=16
Data van een excel blad wordt gebruikt om een listbox te vullen, maar je kan ook toevoegen en raadplegen.

 

[Jarodxxx]

Listbox Voorbeeld Formulier

Tx Withaar!

Hiero een voorbeeld, misschien maakt dat meer duidelijk.

Het moet er zo uitzien als het voorbeeld.
Hier wordt gewerkt met een listbox, ik kan wel mooi alles selecteren, maar kopieren naar bv een nieuw werkblad is er niet bij. Dit zou ik toch wel een handige functionaliteit vinden.

Jarod

 

[Cobbe]

Kijk eens of dit is wat je bedoelt.

Cobbe

 

[Jarodxxx]

Zo!

Dat komt aardig in de richting vriend!

Sorry, maar ik ben niet volledig geweest.
Elke keer dat je dit nu selecteert gaat het naar blad2 dat wordt nogal veel.

Wat ik meer zoek is een soort export knop naar een nieuw bestand ofzo, waar de gegevens dan heen gekopieerd worden.

Je selecteert een aantal gegevens (kan met shift een rij of met ctr een aantal specifiek) klikt op export of iets van ctrl + c (als 't kan) en dan gaat het naar een nieuw bestand, of kun je het daar plakken

Jarod

ps: sorry voor de slechte beschrijving eerder!

 

[Demeter]

J,

Probeer de volgende code eens achter een knop op je userform te plakken (let wel op de knop benaming):

Private Sub CommandButton1_Click()
Dim iloop, legeregel As Integer

    For iloop = 1 To ListBox1.ListCount
        If ListBox1.Selected(iloop - 1) = True Then
            legeregel = Sheets("Blad2").Range("A65536").End(xlUp).Row + 1
            Sheets("Blad1").Range("A" & iloop + 1).EntireRow.Copy Sheets("Blad2").Range("A" & legeregel)
         End If
    Next iloop
    
    Unload Me

End Sub

code komt van Ozgrid, heb hem iets aangepast.
Zie: http://www.ozgrid.com/News/ExcelLookupPart3VBASplashListBox.htm en zoek op Multi

Succes

 

[Jarodxxx]

Coolio!

Demeter,

Bijna 100% van wat ik zocht.
Zou je nog zo vriendelijk willen zijn om het zo aan te passen dat hij enkel de actieve selectie kopieert? Als ik namenlijk nu een aantal selecteer en daarna weer de-selecteer kopieert hij ze toch.

En of het mogelijk is om dit naar een nieuw excelbestand te kopieren en dan zeg maar 1x de informatie, want ik krijg nu EN de listbox EN de info uit de onderliggende cellen. Vanuit gebruikers oogpunt is De onderliggende info misschien het handigst? (al verdeeld over de cellen)

Alvast maar weer bedankt!

Jarod

 

[Jarodxxx]

Listbox kopieren

Iemand die mij met het laatste van deze vraag kan helpen?

Edit: voorbeeldbestand toegevoegd.

1. ik wil graag wat ik selecteer kopieren naar een nieuw bestand (voor een deel wil dit, maar 't kopieren niet)

2. Ik wil als ik iets deselecteer dat het dan niet mee gaat (nu gebeurd dat wel helaas)

3. Niet de info uit de listbox, maar uit de onderliggende (of de listbox info scheidden in apparte kolommen? in het nieuwe bestand?)

Jarod

 

[Wigi]

Een 2de listbox gebruiken is zinloos, je kan Headers specifiëren voor de listbox1.

Lees eens eerst deze topic door, dan is de listbox tenminste toch al goed gebouwd.

Wigi

 

[Wigi]

Allé, hier is alle code Behalve dan de slechte stukken die er eerder in stonden.

Dim rngGegevens As Range

Private Sub CommandButton1_Click()

    Dim iLoop As Long
    
    With Me.ListBox1
        For iLoop = 1 To .ListCount
            If .Selected(iLoop - 1) Then _
                rngGegevens.Rows(iLoop).Copy Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        Next
    End With
    
    Unload Me

End Sub

Private Sub Userform_initialize()
    
    With Sheets(1).Range("A1").CurrentRegion
        Set rngGegevens = .Offset(1).Resize(.Rows.Count)
    End With
    Me.ListBox1.RowSource = rngGegevens.Address

End Sub

Private Sub ListBox1_Change()
    Dim a As Integer
    Dim sTussen As String

    sTussen = "     -     "

    With Me.ListBox1
        a = .ListIndex
        If a > -1 Then _
           TextBox1.Text = .List(a, 0) & sTussen & .List(a, 1) & sTussen & .List(a, 2) & sTussen & Format(.List(a, 3), "d mmmm yyyy")
    End With
End Sub

Private Sub UserForm_Activate()
    ListBox1.SetFocus
End Sub

'COMMANDBUTTON SLUITEN'

Private Sub CommandButtonSluiten_Click()
    Unload Me
End Sub

Zie bijlage voor een aantal andere aanpassingen. O.a. die van Bob Philips.

Wigi

 

[Jarodxxx]

hallelujah

Wigi,

Jij kan sneller dit produceren, dan ik het onder de knie kan krijgen:thumb:
Knap werk. Ik heb 't al overal toegepast in m'n model, 't werkt fantastisch.

Kun jij de export voor mij laten verlopen naar een nieuwe bestand?
Ik heb dit geprobeerd met

workbooks.add,

wat op zich een prima manier is om een nieuw bestand te openen, maar 't werkt niet.
Ik denk vanwege de loop-functie? (herhaal deze functie net zo lang tot dat).
Hij opent nu steeds een nieuw bestand denk ik? + dat hij niet meer naar me.listbox kan kijken?

Hij moet switchen tussen beide bestanden?

Juiste redenatie?

't is weer super!

Groeten,

J.

 

[Jarodxxx]

Wie o Wie

Is er iemand, die weet hoe ik het voorbeeld van wigi zo krijg dat hij de gegevens kopieert naar een nieuw excelbestand?


Met vriendelijke groet,

J.

 

[Wigi]

Je kan toch VOOR de lus een nieuw bestand openen, wegschrijven, en terug sluiten?

 

[Jarodxxx]

Juistem

Wigi,

Dat is ook wat ik zelf had bedacht (sluiten hoeft niet, 't is een export).
Alleen er ontstaat een probleem met de loop denk ik.

Het openen van een nieuw bestand gaat prima, alleen dan 'snapt' de loop niet meer dat de gegevens naar het nieuwe bestand moeten.

Wat zie ik over het hoofd? Volgens mij, wordt het nu niet naar het nieuwe bestand gekopieerd?

Private Sub CommandButton1_Click()

Workbooks.Add

    Dim iLoop As Long
    
    [COLOR="#ff0000"]With Me.ListBox1[/COLOR]
        For iLoop = 1 To .ListCount
            If .Selected(iLoop - 1) Then
               [COLOR="Red"] rngGegevens.Rows(iLoop).Copy Sheets("Blad2").Range("A" & [/COLOR]Rows.Count).End(xlUp).Offset(1)
            End If
        Next
    End With
    
    Unload Me

End Sub

tx maar weer

Jarod

 

[Wigi]

Zoiets

Private Sub CommandButton1_Click()

    Dim wbNieuw As Workbook
    
    Set wbNieuw = Workbooks.Add
    
    Dim iLoop As Long
    
    With Me.ListBox1
        For iLoop = 1 To .ListCount
            If .Selected(iLoop - 1) Then
               rngGegevens.Rows(iLoop).Copy wbNieuw.Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next
    End With
    
    Unload Me
    
    wbNieuw.SaveAs '...

End Sub

Wigi

 

[Jarodxxx]

Dat is balen voor mij

Wigi,

Werkt weer perfect!
Ik heb dat geprobeerd, alleen kreeg 't niet aan de praat, ik zie nu al waarom hehe!
Bedankt!

Hij kopieert nu niet de koppen? Kan dat?


Ik heb dit er van gebrouwen (is + opslaan op locatie met de datum erbij die ik aangeef)
(Ik gok: Mede mogelijk gemaakt door Wigi :thumb: )

'Exporteerfunctie'

Dim WBNieuw As Workbook
Dim MyDate, MyFile, MyPath, MyName

'WBNieuw = Openen new workbook'
    Set WBNieuw = Workbooks.Add

    Dim iLoop As Long
    
    With Me.ListBox1
        For iLoop = 1 To .ListCount
            If .Selected(iLoop - 1) Then
                rngGegevens.Rows(iLoop).Copy WBNieuw.Sheets("Blad1").Range("A" & Rows.Count).End(xlUp).Offset(1)
            End If
        Next
    End With
    
    Unload Me

'Kopie Opslaan van de Module op Basis van een Naam en Datum'

        MyPath = "C:\Stamkaart\Export Files"
        MyName = "Medewerkersregister "
        MyDate = Format(Date, "yyyymmdd")
        MyFile = MyPath + "\" + MyName + MyDate + ".xls"
    
    Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs Filename:=MyFile, FileFormat:=xlNormal, _
            Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False

'Sluit Export file'
    WBNieuw.Close
End Sub

J.