AW: Zeilen und Inhalte mittels Button verschieben
11.08.2009 23:22:24
Josef
Hallo Lemmi,
kopiere die Codeteile in die entsprechenden Module, Datei speichern, schliessen und wieder öffnen.
Mit "Alt+Pfeil auf" bzw. "Alt+Pfeil ab", wird der Code ausgeführt.
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_Activate()
Application.OnKey "%{UP}", "moveUP"
Application.OnKey "%{DOWN}", "moveDOWN"
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "%{UP}"
Application.OnKey "%{DOWN}"
End Sub
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Sub moveSelection(Optional Direction As String = "up")
Dim rng As Range
Dim varMove As Variant, varOld As Variant
Dim lngFirst As Long, lngLast As Long, lngOld As Long
Set rng = Selection
lngFirst = rng.Cells(1, 1).Row
lngLast = lngFirst + rng.Rows.Count - 1
If lngFirst = 1 And LCase(Direction) = "up" Then Exit Sub
If lngLast = Rows.Count And LCase(Direction) = "down" Then Exit Sub
If LCase(Direction) = "up" Then
varOld = Range(Cells(lngFirst - 1, 3), Cells(lngFirst - 1, Columns.Count))
varMove = Range(Cells(lngFirst, 3), Cells(lngLast, Columns.Count))
Range(Cells(lngFirst, 3), Cells(lngLast, Columns.Count)).Offset(-1, 0) = varMove
Range(Cells(lngLast, 3), Cells(lngLast, Columns.Count)) = varOld
rng.Offset(-1, 0).Select
ElseIf LCase(Direction) = "down" Then
varOld = Range(Cells(lngLast + 1, 3), Cells(lngLast + 1, Columns.Count))
varMove = Range(Cells(lngFirst, 3), Cells(lngLast, Columns.Count))
Range(Cells(lngFirst, 3), Cells(lngLast, Columns.Count)).Offset(1, 0) = varMove
Range(Cells(lngFirst, 3), Cells(lngFirst, Columns.Count)) = varOld
rng.Offset(1, 0).Select
End If
Set rng = Nothing
End Sub
Sub moveUP()
moveSelection
End Sub
Sub moveDOWN()
moveSelection "down"
End Sub
Gruß Sepp