Move op og ned i en tabel

Det er jo et godt spørgsmål..... det afhænger jo lidt af hvordan du har lavet det.
Smid arket i en mail til fd@win-consult.com, så vil jeg hjælpe dig i aften, hvis ikke du har fået hjælp inden.

Følgende scroller 30 rækker ned

Sub Makro1()
    ActiveWindow.SmallScroll Down:=30
End Sub

Der er så lige problematikken med at knapperne ikke følger med scrollet.

Eksempel sendt retur.

Her er også et løsningsforslag, da jeg har fundet ud af at få knapperne til at følge med op og ned ved scrolling.
For følgende gælder at der skal være 2 knapper i arket, en der hedder Op og en der hedder ned.
De tre makroer kopieres og lægges i et modul.

Sub ScrollDown()
    Dim nUp As Single
    nUp = ActiveWindow.VisibleRange.Cells(1, 1).Top
    ActiveWindow.SmallScroll Down:=30 'scroller 30 linier ned
    ActiveWindow.VisibleRange.Cells(1, 1).Select
    KeepControls True, nUp
End Sub
Sub ScrollUp()
    Dim nUp As Single
    nUp = ActiveWindow.VisibleRange.Cells(1, 1).Top
    ActiveWindow.SmallScroll Up:=30 'scroller 30 linier op
    ActiveWindow.VisibleRange.Cells(1, 1).Select
    KeepControls False, nUp
End Sub
Sub KeepControls(Dwn As Boolean, nUp As Single)
' Denne makro sørger for at alle knapper følger med op/ned.
    Dim sh As Shape
    For Each sh In ActiveSheet.Shapes 'vælger alle knapper
        With sh
            Select Case .Name
                Case "Op", "Ned" 'knappernes navne
                Case Else
                    x = .Top - nUp
                    If Dwn Then
                      .Top = ActiveWindow.VisibleRange.Cells(1, 1).Top + x
                    Else
                      .Top = ActiveWindow.VisibleRange.Cells(1, 1).Top + x
                    End If
            End Select
        End With
    Next
End Sub

-> flemmingdahl, jeg vil også gerne se dit løsningsforslag. Man kunne måske lære noget nyt, det har jeg i hvert fald gjort, da jeg sad og rodede med det her  :o)
Min e-mail: soeren109@hotmail.com

Hej Søren

Koden jeg har lavet er til en userform, som firstchoice har sendt til mig, hvor vidt om en kopi af regnearket sendes videre til dig vil jeg lade firstchoice om. Dog vil jeg postere koden her om lidt.

Private Const mlHeaderRow As Long = 6
Private mrCurReg As Range
Private mbFoundDB As Boolean
Private mobjCtl As MSForms.Control

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
    If Me.scbRecords.Value = Me.scbRecords.Max Then
        WriteRecord True
    Else
        WriteRecord False
    End If
End Sub

Private Sub scbRecords_Change()
    ReadRecord
End Sub

Private Sub UserForm_Initialize()
    mbFoundDB = True
   
    ' Determin database range
    Set mrCurReg = ActiveSheet.UsedRange
    If mrCurReg.Rows.Count = mlHeaderRow Then mbFoundDB = False
    Set mrCurReg = mrCurReg.Offset(mlHeaderRow, 0).Resize( _
        mrCurReg.Rows.Count - mlHeaderRow)
   
    If mbFoundDB Then
        Me.scbRecords.Min = 1
        Me.scbRecords.Max = mrCurReg.Rows.Count + 1
        Me.scbRecords.Value = 1
        ReadRecord
    End If
End Sub

Private Sub UserForm_Terminate()
    Set mrCurReg = Nothing
    Set mobjCtl = Nothing
End Sub

Private Sub ReadRecord()
    For Each mobjCtl In Me.Controls
        Select Case TypeName(mobjCtl)
            Case "TextBox"
                mobjCtl.Text = mrCurReg.Cells(Me.scbRecords.Value, Val(Right(mobjCtl.Name, 2))).Value
        End Select
    Next mobjCtl
End Sub

Private Sub WriteRecord(ByVal bCreateNew As Boolean)
    If bCreateNew Then
        Me.scbRecords.Value = Me.scbRecords.Max
        Me.scbRecords.Max = Me.scbRecords.Max + 1
        Set mrCurReg = mrCurReg.Resize(Me.scbRecords.Max)
    End If
   
    For Each mobjCtl In Me.Controls
        Select Case TypeName(mobjCtl)
            Case "TextBox"
                mrCurReg.Cells(Me.scbRecords.Value, Val(Right(mobjCtl.Name, 2))).Value = mobjCtl.Text
        End Select
    Next mobjCtl
End Sub

Jeg har lavet en lille eksempelfil med userform i, den sender jeg.

Det er fint nok med koden, tak.
Nu må jeg så se, om jeg kan tygge mig gennem den og forstå den  :o)

En eksempelfil er da meget velkommen.

Ok, det var ikke sådan jeg havde opfattet spm., men en rigtig god løsning som jeg godt kan gøre brug af.

Spørgsmålet kunne også forståes på flere måder, det var også derfor jeg bad om en fil. God fornøjelse med det.

firstchoice - er vi færdige her ?

Jeg siger tak for hjælpen, og bøvler videre

Fino :-) Lukker du så ikke spørgsmålet.

Flemming> Må jeg se eksempelfilen?

Hej Flemming.
Jeg troede jeg havde afsluttet sagen.
Beklager

Helt ok :-)