Help, code bij spinbutton niet optimaal

[Ricky2]

Wie wil mij helpen. Deze vraag had ik al eerder gesteld en ik ben nu zover dat ik heb begrepen dat de code die ik gebruik werkt,doch niet optimaal is.

In bijgaand XLS bestand is een userform opgenomen waarbij je in een werkblad (en ook in het formulier zelf) een drietal gegevens muteren in drie naast elkaar gelegen kolommen.

Het gaat hier om een klantnummer (numeriek veld) + 2 andere waarden.

De gehele userform werkt prima, behalve de spinbutton die als doel heeft om de geselecteerde regel omhoog danwel omlaag te verplaatsen.

De 1e keer gaat het altijd goed, daarna verdwijnt op één of andere manier de 'focus' op de listbox waarin deze 3 kolommen ook zichtbaar zijn. Pas als je met je muis een regel bewust wederom selecteert functioneert de spinbutton goed.

Ik moet dus telkenmale opnieuw de betreffende regel in de listbox opnieuw aanklikken.

Wat doe ik fout. Ik ben bijna wanhopig

Ricky.

Overigens is dit de code die aan het userform is gekoppeld:

Option Explicit
Dim lCurrentListIndex As Long
Dim strRowSource As String
Dim strAddress As String
Dim strSheetName As String
Dim RowCount As Long

Private Sub Quit_Click()
    Unload Me
End Sub

Private Sub Clear_Click()
    Sheet11.Range("C22:E51").Value = vbNullString
    Undo_Click
End Sub

Private Sub Undo_Click()
    Me.Customer = vbNullString
    Me.Parameters.ListIndex = -1
    Me.Percentage.ListIndex = -1
    Me.Customer.SetFocus
End Sub

Private Sub Delete_Click()
With ListBox
  If .ListIndex < 0 Or .ListIndex = .ListCount - 1 Then Exit Sub
    lCurrentListIndex = .ListIndex + 1
    strRowSource = .RowSource
    strAddress = Range(strRowSource).Address
    strSheetName = Range(strRowSource).Parent.Name
    .RowSource = vbNullString
        With Range(strRowSource)
            .Rows(lCurrentListIndex).Value = vbNullString
        End With
     Sheets(strSheetName).Range(strAddress).Name = strRowSource
    .RowSource = strRowSource
    .Selected(lCurrentListIndex) = True
End With
End Sub


Private Sub Submit_Click()

RowCount = Sheet11.Range("C21").CurrentRegion.Rows.Count

If Not IsNumeric(Me.Customer.Value) And Me.Customer.Value <> vbNullString Then
    MsgBox "Sorry, alleen numerieke waarden toegestaan", vbExclamation
    Me.Customer.SetFocus
    Exit Sub
End If

If RowCount = 31 Then    'maximaal 31 regels mogen gevuld worden (30 nummers + header)
    MsgBox "U heeft al het maximaal aantal klantnummers (" & RowCount - 1 & ") ingegeven", vbOKOnly
    Undo_Click
 Else
    With Sheet11.Range("C21")
        If Me.Customer.Value <> vbNullString And Me.Parameters.Value <> vbNullString And Me.Percentage.Value <> vbNullString Then
            .Offset(RowCount, 0).Value = Me.Customer.Value
            .Offset(RowCount, 1).Value = Me.Parameters.Value
            .Offset(RowCount, 2).Value = FormatPercent(Me.Percentage.Value, 0)
        Else
            Exit Sub
        End If
    End With
    Undo_Click
End If
    
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        If CloseMode = 0 Then Cancel = True
End Sub

Private Sub SpinButton1_SpinDown()
With ListBox
  If .ListIndex < 0 Or .ListIndex = .ListCount - 1 Then Exit Sub
    lCurrentListIndex = .ListIndex + 1
    strRowSource = .RowSource
    strAddress = Range(strRowSource).Address
    strSheetName = Range(strRowSource).Parent.Name
    .RowSource = vbNullString
        With Range(strRowSource)
            .Rows(lCurrentListIndex).Cut
            .Rows(lCurrentListIndex + 2).Insert Shift:=xlDown
        End With
     Sheets(strSheetName).Range(strAddress).Name = strRowSource
    .RowSource = strRowSource
    .Selected(lCurrentListIndex) = True
End With
    
End Sub

Private Sub SpinButton1_SpinUp()

With ListBox
  If .ListIndex < 1 Then Exit Sub
    lCurrentListIndex = .ListIndex + 1
    strRowSource = .RowSource
    strAddress = Range(strRowSource).Address
    strSheetName = Range(strRowSource).Parent.Name
    .RowSource = vbNullString
        With Range(strRowSource)
            .Rows(lCurrentListIndex).Cut
            .Rows(lCurrentListIndex - 1).Insert Shift:=xlDown
        End With
     Sheets(strSheetName).Range(strAddress).Name = strRowSource
    .RowSource = strRowSource
    .Selected(lCurrentListIndex - 2) = True
      
End With
    
End Sub

 

[Wigi]

Voeg onderaan dit toe:

Me.ListBox.SetFocus

Wigi

 

[Ricky2]

Toevoeging helpt niet

Hoi Wigi,

Dank voor het meedenken maar...
Het verbaasd me, maar je tip werkt klaarblijkelijk niet.

Enig ander idee ?!

 

[Wigi]

Waar heb je die regel code geplakt?

En die moet er 2 keer komen, zowel voor SpinUp als SpinDown.

 

[Ricky2]

Fout gevonden !

Hoi Wigi,

Ik had de regel inderdaad 2x geplakt.
De oorzaak heb ik echter inmiddels gevonden en deze lag ergens anders.

Optisch werd de juiste regel geselecteerd, doch 'onder water' werd de variabele .ListIndex ALTIJD op 0 gezet !!

Kortom door geheel onderaan bij elke subroutine deze waarde te manipuleren was de ListIndex gelijk aan de getoonde geselecteerde regel.

Dit heb ik toegevoegd, net voor het End With statement:

.ListIndex = lCurrentListIndex

Probleem opgelost !! Ook voor de delete button

Nogmaals bedankt voor je meedenken !:thumb:

Ik heb mijn bestand (opnieuw) ge-uploaded met de aanpassingen. Werkt als een zonnetje