Listbox-posuv v listboxu řádků s více sloupci Vyřešeno

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Fanatig
nováček
Příspěvky: 46
Registrován: září 12
Pohlaví: Muž
Stav:
Offline

Listbox-posuv v listboxu řádků s více sloupci

Příspěvekod Fanatig » 06 pro 2012 17:14

Dobrý den,tak a je tu další zádrhel s Listboxem.
V listboxu mam několik řádků s 10 sloupci.A tu a tam bych potřeboval zaměnit určitý řádek buď o řád výš nebo o řád níže.
Kód co používám přesouvá pouze první sloupec a ostatní vymaže.Poradíte někdo prosím co s tím?

Zatím používám tyto kódy:

Private Sub Nahoru_Click()
If ListBox1.ListIndex <= 0 Then Exit Sub
PocetPolozek = ListBox1.ListCount
Dim DocasnySeznam()
ReDim DocasnySeznam(0 To PocetPolozek - 1)
'Naplnime pole položkami seznamu
For i = 0 To PocetPolozek - 1
DocasnySeznam(i) = ListBox1.List(i)
Next i
'určime vybranou položku
CisloPolozky = ListBox1.ListIndex
'Prohodíme položky

DocasnaPolozka = DocasnySeznam(CisloPolozky)
DocasnySeznam(CisloPolozky) = DocasnySeznam(CisloPolozky - 1)
DocasnySeznam(CisloPolozky - 1) = DocasnaPolozka
ListBox1.List = DocasnySeznam

'Změníme vybranou položku
ListBox1.ListIndex = CisloPolozky - 1

End Sub

Private Sub Dolu_Click()
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
PocetPolozek = ListBox1.ListCount
Dim DocasnySeznam()
ReDim DocasnySeznam(0 To PocetPolozek - 1)
'Naplníme pole položkami seznamu
For i = 0 To PocetPolozek - 1
DocasnySeznam(i) = ListBox1.List(i)
Next i
'Určíme vybranou položku
CisloPolozky = ListBox1.ListIndex
'Změníme vybranou položku
DocasnaPolozka = DocasnySeznam(CisloPolozky)
DocasnySeznam(CisloPolozky) = DocasnySeznam(CisloPolozky + 1)
DocasnySeznam(CisloPolozky + 1) = DocasnaPolozka
ListBox1.List = DocasnySeznam
'Změníme vybranou položku
ListBox1.ListIndex = CisloPolozky + 1
End Sub

Reklama
Fanatig
nováček
Příspěvky: 46
Registrován: září 12
Pohlaví: Muž
Stav:
Offline

Re: Listbox-posuv v listboxu řádků s více sloupci  Vyřešeno

Příspěvekod Fanatig » 08 pro 2012 21:49

tak po dlouhým hledání na netu jsem našel kód mého řešení

Private Sub Nahoru_Click()

MoveItem -1

End Sub

Private Sub Dolu_Click()

MoveItem 1

End Sub

Private Sub MoveItem(lOffset As Long)

Dim aTemp() As String
Dim i As Long

With Me.ListBox1
If .ListIndex > -1 Then
ReDim aTemp(0 To .ColumnCount - 1)
For i = 0 To .ColumnCount - 1
aTemp(i) = .List(.ListIndex + lOffset, i)
.List(.ListIndex + lOffset, i) = .List(.ListIndex, i)
.List(.ListIndex, i) = aTemp(i)
Next i
End If
End With
End Sub

--- Doplnění předchozího příspěvku (09 Pro 2012 00:38) ---

jen to chce ještě doladit,když to bude na prvním řádku a omylem se klikne na tlačítko tak to nahlásí chybu to stejný provádí při poslední položce


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Je potřeba 16 nebo 20 a více VRAM ve hrách?
    od p3v4x » 20 črc 2024 23:06 » v Problémy s hardwarem
    2
    2678
    od p3v4x Zobrazit poslední příspěvek
    21 črc 2024 18:39
  • více ssd na desku asrock b450 pro4 Příloha(y)
    od bugicek7lpCZ » 03 lis 2024 16:43 » v Rady s výběrem hw a sestavením PC
    3
    1478
    od MrVoltz Zobrazit poslední příspěvek
    05 lis 2024 08:17
  • Canon pixma ts5150 w11 nelze tisknout vice kopii na stranku Příloha(y)
    od mrpcz » 20 kvě 2025 07:09 » v Vše ostatní (hw)
    4
    2363
    od petr22 Zobrazit poslední příspěvek
    20 kvě 2025 13:30

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 0 hostů