17.11.2019, 13:27
Hallo Mingos,
ich habe den Code noch bereinigt sowie die Entfernen-Taste aus der Tab-Steuerung genommen, so dass man mit ihr Einträge wieder entfernen kann.
Hier bspw. war schon mal etwas ähnliches: Excel Netzplan die 2.: Reihenfolge der Eingabezellen festlegen
ich habe den Code noch bereinigt sowie die Entfernen-Taste aus der Tab-Steuerung genommen, so dass man mit ihr Einträge wieder entfernen kann.
Hier bspw. war schon mal etwas ähnliches: Excel Netzplan die 2.: Reihenfolge der Eingabezellen festlegen
' **************************************************************
' Modul: DieseArbeitsmappe Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************
Option Explicit
Private Sub Workbook_Activate()
If ActiveSheet.CodeName = "Tabelle1" Then '<< TabellenCodename anpassen
If Not Application.Intersect(ActiveCell, Range("C4:G40")) Is Nothing Then
TabsteuerungEin
End If
End If
End Sub
Private Sub Workbook_Deactivate()
If ActiveSheet.CodeName = "Tabelle1" Then '<< TabellenCodename anpassen
TabsteuerungAus
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Sh.CodeName = "Tabelle1" Then '<< TabellenCodename anpassen
If Not Application.Intersect(ActiveCell, Range("C4:G40")) Is Nothing Then
TabsteuerungEin
End If
Else
TabsteuerungAus
End If
End Sub
' **************************************************************
' Modul: Tabelle1 Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(ActiveCell, Range("C4:G40")) Is Nothing Then
TabsteuerungEin
Else
TabsteuerungAus
End If
End Sub
' **************************************************************
' Modul: mTabsteuerung Typ = Allgemeines Modul
' **************************************************************
Option Explicit
Dim bolR As Boolean
Public Sub TabsteuerungAus()
Dim i As Long
For i = 1 To 255
Application.OnKey "{" & i & "}"
Application.OnKey "+{" & i & "}"
Application.OnKey "^{" & i & "}"
Application.OnKey "%{" & i & "}"
Application.OnKey "+^{" & i & "}"
Application.OnKey "+%{" & i & "}"
Application.OnKey "^%{" & i & "}"
Application.OnKey "+^%{" & i & "}"
Next i
'MsgBox "Tabsteuerung ist ausgeschaltet", vbInformation, "Tabsteuerung"
End Sub
Public Sub TabsteuerungEin()
Dim i As Long
For i = 1 To 255
Application.OnKey "{" & i & "}", "TabV"
Application.OnKey "+{" & i & "}", "TabV"
Application.OnKey "^{" & i & "}", "TabV"
Application.OnKey "%{" & i & "}", "TabV"
Application.OnKey "+^{" & i & "}", "TabV"
Application.OnKey "+%{" & i & "}", "TabV"
Application.OnKey "^%{" & i & "}", "TabV"
Application.OnKey "+^%{" & i & "}", "TabV"
Next i
Application.OnKey "{DEL}" 'Entfernen-Taste aus der Steuerung nehmen
Application.OnKey "{" & 49 & "}", "Eintrag1" 'Ziffer Eins
Application.OnKey "{" & 97 & "}", "Eintrag1" 'Ziffer Eins (Zehnertastatur)
Application.OnKey "{" & 50 & "}", "Eintrag2" 'Ziffer Zwei
Application.OnKey "{" & 98 & "}", "Eintrag2" 'Ziffer Zwei (Zehnertastatur)
Application.OnKey "{RIGHT}", "TabV" 'NACH-RECHTS-TASTE
Application.OnKey "{TAB}", "TabV" 'TAB
Application.OnKey "{ENTER}", "TabV" 'EINGABETASTE (Zehnertastatur)
Application.OnKey "{RETURN}", "TabV" 'EINGABETASTE
Application.OnKey "{LEFT}", "TabZ" 'NACH-LINKS-TASTE
Application.OnKey "{BS}", "TabZ" 'RÜCKTASTE
Application.OnKey "+{TAB}", "TabZ" 'UMSCHALT+TAB
Application.OnKey "+{ENTER}", "TabZ" 'UMSCHALT+EINGABETASTE (Zehnertastatur)
Application.OnKey "+{RETURN}", "TabZ" 'UMSCHALT+EINGABETASTE
'MsgBox "Tabsteuerung ist eingeschaltet", vbInformation, "Tabsteuerung"
End Sub
Private Sub Eintrag1()
ActiveCell.Value = 1
TabV
End Sub
Private Sub Eintrag2()
ActiveCell.Value = 2
TabV
End Sub
Private Sub TabV()
bolR = False
Navigieren
End Sub
Private Sub TabZ()
bolR = True
Navigieren
End Sub
Private Sub Navigieren()
Dim i As Long, j As Long
Static strZ As String
Dim varA As Variant
varA = Array("C4", "D4", "E4", "F4", "G4", "C5", "D5", "E5", "F5", "G5", "C6", "D6", "E6", "F6", "G6", "C7", "D7", "E7", "F7", "G7", "C8", "D8", "E8", "F8", "G8", "C9", "D9", "E9", "F9", "G9", "C10", "D10", "E10", "F10", "G10", "C11", "D11", "E11", "F11", "G11", _
"C12", "D12", "E12", "F12", "G12", "C13", "D13", "E13", "F13", "G13", "C14", "D14", "E14", "F14", "G14", "C15", "D15", "E15", "F15", "G15", "C16", "D16", "E16", "F16", "G16", "C17", "D17", "E17", "F17", "G17", "C18", "D18", "E18", "F18", "G18", "C19", "D19", "E19", "F19", "G19", _
"C20", "D20", "E20", "F20", "G20", "C21", "D21", "E21", "F21", "G21", "C22", "D22", "E22", "F22", "G22", "C23", "D23", "E23", "F23", "G23", "C24", "D24", "E24", "F24", "G24", "C25", "D25", "E25", "F25", "G25", "C26", "D26", "E26", "F26", "G26", "C27", "D27", "E27", "F27", "G27", _
"C28", "D28", "E28", "F28", "G28", "C29", "D29", "E29", "F29", "G29", "C30", "D30", "E30", "F30", "G30", "C31", "D31", "E31", "F31", "G31", "C32", "D32", "E32", "F32", "G32", "C33", "D33", "E33", "F33", "G33", "C34", "D34", "E34", "F34", "G34", "C35", "D35", "E35", "F35", "G35", _
"C36", "D36", "E36", "F36", "G36", "C37", "D37", "E37", "F37", "G37", "C38", "D38", "E38", "F38", "G38", "C39", "D39", "E39", "F39", "G39", "C40", "D40", "E40", "F40", "G40")
For i = 0 To UBound(varA) - 1
If varA(i) = ActiveCell.Address(0, 0) Then
j = 1
Exit For
End If
Next i
If j = 1 Then
strZ = ActiveCell.Address(0, 0)
j = 0
Else
For i = 0 To UBound(varA) - 1
If varA(i) = strZ Then Exit For
Next i
End If
If bolR Then
If i = 0 Then
strZ = varA(UBound(varA) - j)
Else
strZ = varA(i - j - 1)
End If
Else
strZ = varA((i + j + 1) Mod (UBound(varA) + 1))
End If
Range(strZ).Select
End Sub
