Listbox voorzien van opmaak

[Offthefield]

Ik ben bezig met een programma maar daarin wil ik de gegevens in de listbox
opgemaakt (vooral datum, tekst en bedragen) hebben bv.

getal nu 100 moet worden 100,00
datum nu 3-7-2017 moet worden 03-07-2017
tekst nu 560.00000450 moet een tekst blijven

Heeft iemand een idee hoe ik deze kan aanpassen?

Alvast hartelijk dank

 

[edmoor]

Probeer het eens zo:

Private Sub UserForm_Initialize()
    Dim lsbindex As Integer
    
    With lsb1
        .List = [Data].Value
        [Data].AutoFilter
        .ColumnWidths = "40;100;160;40;60;40;80"
        .ColumnCount = 7
        For lsbindex = 0 To .ListCount - 1
            .List(lsbindex, 4) = Format(.List(lsbindex, 4), "€#,##0.00")
            .List(lsbindex, 5) = Format(.List(lsbindex, 5), "€#,##0.00")
            .List(lsbindex, 6) = Format(.List(lsbindex, 6), "DD-MM-YYYY")
        Next
    End With
End Sub

 

[Offthefield]

Perfect!!!!, ik wil alleen nog apart een paar velden naar rechts laten uitlijnen,
maar dat blijkt niet per veld te gaan, maar het decimaal en datumopmaak probleem is opgelost TOP!!!

 

[snb]

Private Sub UserForm_Initialize()
    sn = Cells(1).CurrentRegion
    For Each it In Cells(1).CurrentRegion
       sn(it.Row, it.Column) = it.Text
    Next

    ListBox1.List = sn
End Sub

 

[Offthefield]

Bedankt snb,

Kan je een korte uitleg geven, hoe ik dit per veld kan invoeren,
want ik zie het niet helemaal

Alvast bedankt

 

[edmoor]

Wat daar gebeurt is dat de regel per cel naar Tekst wordt geconverteerd, incl. het uiterlijk en vervolgens in een array gezet.
De array wordt dan in de listbox geplaatst.

Een andere benadering dus.

 

[snb]

@Edm

Er wordt niets geconverteerd; de eigenschap .Text van iedere cel wordt ingelezen.

 

[edmoor]

Inderdaad, dat was een onjuiste benaming.

 

[Offthefield]

Klasse!!!!,

Ik ga het uitproberen, en maak gelijk aantekeningen erbij

 

[Offthefield]

Zoeken in listbox vanaf kolom B

Ik heb een programma met een zoekbutton die zoekt in een gebied vanaf A2:K100 (hieronder),
nu wil ik gaan zoeken in B2:L101, welke regel zorgt er voor dat hij het juiste zoek gebied neemt?
en wat moet hieraan veranderd worden

Private Sub SearchButton_Click()
'
With lsb1
.Font.Size = 8
  .List = Sheets("Artikellijst").Cells(1).CurrentRegion.Value
    For i = .ListCount - 1 To 1 Step -1
     If InStr(LCase(Join(Application.Index(.List(), i + 1, 0))), LCase(txbSearch.Value)) = 0 Then .RemoveItem i
   Next i
 End With
'
End Sub

Alvast hartelijk dank

 

[Offthefield]

Sorry, per abuis zet ik een nieuwe vraag onder een oude vraag,
moet ik een nieuw bericht plaatsen of kan dit blijven staan?

 

[HSV]

Als A2:L101 een aaneengesloten bereik is helemaal niets.
Met....

Join(Application.Index(.List(), i + 1, 0))

..wordt er in elke rij van de listbox gekeken.

 

[Offthefield]

HSV,

Duidelijk, hartelijk dank

 

[Offthefield]

Hoe kan je de opmaak per veld bepalen in de onderstaande macro ?

Alvast hartelijk dank voor de reactie

Private Sub SearchButton_Click()
'
With lsb1
.Font.Size = 8
  .List = Sheets("Artikellijst").Cells(1).CurrentRegion.Value
    For i = .ListCount - 1 To 1 Step -1
     If InStr(LCase(Join(Application.Index(.List(), i + 1, 0))), LCase(txbSearch.Value)) = 0 Then .RemoveItem i
   Next i
 End With
'
End Sub

 

[HSV]

With lsb1
 For i = 0 To .ListCount - 1
  .List(i, 6) = Format(.List(i, 6), "dd-mm-yyyy")
 Next i
.Font.Size = 8

Ik vermoed dat je de lettergrootte per veld vergroten wilt, maar dat zal niet gaan.

 

[Offthefield]

HSV, Bedankt voor de snelle reactie,

Ik heb zitten puzzelen waar en hoe ik de zoekveld (txbSearch.Value) moet plaatsen om hem te laten
zoeken en de nieuwe opmaak erbij te plaatsen in SearchButton_Click

Heeft iemand een idee, waar deze geplaatst dient worden?

Alvast hartelijk dankBekijk bijlage 138-Listbox-Search.xls

Private Sub SearchButton_Click()
' Nieuw Button met opmaak zonder txbSearch
With lsb1
 For i = 0 To .ListCount - 1
  .List(i, 4) = Format(.List(i, 4), "€#,##0.00")
  .List(i, 5) = Format(.List(i, 5), "#0.0")
  .List(i, 6) = Format(.List(i, 6), "dd-mm-yyyy")
 Next i
.Font.Size = 8
End With
'
End Sub
Private Sub SearchButtonORIGINEEL_Click()
' Originele button zonder opmaak
With lsb1
.Font.Size = 8
  .List = Sheets("Registratie").Cells(1).CurrentRegion.Value
    For i = .ListCount - 1 To 1 Step -1
     If InStr(LCase(Join(Application.Index(.List(), i + 1, 0))), LCase(txbSearch.Value)) = 0 Then .RemoveItem i
   Next i
 End With
End Sub

 

[HSV]

Private Sub SearchButton_Click()
With lsb1
  .List = Sheets("Registratie").Cells(1).CurrentRegion.Value
  For i = 0 To .ListCount - 1
    .List(i, 4) = Format(.List(i, 4), "€#,##0.00")
    .List(i, 5) = Format(.List(i, 5), "#0.0")
    .List(i, 6) = Format(.List(i, 6), "dd-mm-yyyy")
  Next i
    For i = .ListCount - 1 To 1 Step -1
     If InStr(LCase(Join(Application.Index(.List(), i + 1, 0))), LCase(txbSearch.Value)) = 0 Then .RemoveItem i
   Next i
 .Font.Size = 8
End With
End Sub

Ps. waarom zet je de lettergrootte niet in de eigenschap?, of veranderd dat per actie.

 

[Offthefield]

HSV,

Geweldig !!!!! TOP man!!!

Ik ga weer verder stoeien om mijn programma te perfectioneren

 

[Offthefield]

Nu stuit ik in het originele programma, als de zoekbutton activeer op de volgende foutmelding :
Fout 13 tijdens uitvoering: Typen komen niet overeen

Op de regel met :
If InStr(LCase(Join(Application.Index(.List(), i + 1, 0))), LCase(txbSearch.Value)) = 0 Then .RemoveItem i

Weet iemand waar dit aan kan liggen ?

Alvast bedankt

 

[Offthefield]

In de macro van de SearchButton de volgende regel tussen geplakt :

On Error Resume Next

Nu werkt hij weer