VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1 
   Caption         =   "UF"
   ClientHeight    =   1620
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   1590
   OleObjectBlob   =   "UserForm1.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "UserForm1"
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@onlinehome.de
'Benutzung frei - ohne Gewähr

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+ Wahlmöglichkeiten (vor dem Aufruf (*) oder in der Userform!):
'+ ganzes Arbeitsblatt (userform1.ob_blatt=true)
'+ oder Selection (userform1.ob_selection=true)
'+ und die Eingabestringlänge (userform1.str_laenge=1)
'+ der Eingabestring wird als LONG an die aktive Zelle
'+ übergeben, somit werden führende Nullen nicht übernommen
'+ (dazu müßte der Code verändert werden)
'+ (*) Bsp Makro für den Userformaufruf:
'+ Sub uf()
'+   UserForm1.Caption = "UF"
'+      ...nur der selektierte Bereich wird gefüllt
'+   UserForm1.ob_Selection = true
'+      ...es werden ZIFFERNstrings der Länge 4 erwartet
'+   UserForm1.str_laenge = 4
'+      ...öffne die Userform
'+   UserForm1.Show
'+End Sub
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Public sr As Long
Public sc As Long
Public srs As Long
Public scs As Long
Public sel As Boolean
Public l As Integer


Private Sub ob_Blatt_Click()
'fülle das Blatt ab der aktuellen Zellposition
  If UserForm1.ob_Blatt Then
     sel = False
     Else
     sel = True
     End If
  TextBox1.SetFocus
End Sub

Private Sub ob_Selection_Click()
'fülle nur den vor dem Aufruf selektierten Bereich
  If UserForm1.ob_Blatt Then
     sel = False
     Else
     sel = True
     End If
  TextBox1.SetFocus
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
'Wiederholung der letzten Eingabe
'solange ENTER Taste gedrückt ist
'Textbox1.Tag dient als LastX Zwischenspeicher
Select Case TextBox1.Tag
  Case Is > "":
     If KeyCode = 13 Then
        KeyCode = 0
        If sel Then
           Call my_proc_s(CInt(Left(TextBox1.Tag, l)))
           Else
           Call my_proc(CInt(Left(TextBox1.Tag, l)))
           End If
        End If
  End Select
'Bewegung des Cursors für eventuelle Korrekturen
Select Case KeyCode
    Case 37: ActiveCell.Offset(0, -1).Activate
    Case 38: ActiveCell.Offset(-1, 0).Activate
    Case 39: ActiveCell.Offset(0, 1).Activate
    Case 40: ActiveCell.Offset(1, 0).Activate
    Case Else:
             If Len(TextBox1) > l Then
                TextBox1 = Left(TextBox1, l)
                End If
    End Select
End Sub

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
Select Case KeyCode
'Eingabe einer Ziffer in die aktive Zelle
'und Sprung in die nächste Zelle
    Case 96 To 105:
                    If Len(TextBox1) < l Then
                       Exit Sub
                       Else
                       TextBox1.Tag = TextBox1
                       End If
                    If sel Then
                        Call my_proc_s(Left(TextBox1, l))
                        Else
                        Call my_proc(Left(TextBox1, l))
                        End If
                        TextBox1 = ""
    Case 37: 'ändere Keycode NICHT!
    Case 38: 'ändere Keycode NICHT!
    Case 39: 'ändere Keycode NICHT!
    Case 40: 'ändere Keycode NICHT!
    Case 27: UserForm_Terminate
    Case 13: 'ändere Keycode NICHT!
    Case Else: KeyCode = 0
               TextBox1 = ""
               TextBox1.Tag = ""
    End Select
End Sub

Private Sub str_laenge_Change()
'ändere die Eingabestringlänge
  l = WorksheetFunction.Max(0, CInt(UserForm1.str_laenge))
  TextBox1.SetFocus
End Sub

Private Sub UserForm_Activate()
  If UserForm1.ob_Blatt Then
     sel = False
     Else
     sel = True
     End If
  l = WorksheetFunction.Max(0, CInt(UserForm1.str_laenge))
  sr = Selection.Row
  sc = Selection.Column
  srs = Selection.Rows.Count
  scs = Selection.Columns.Count
  ActiveCell.Select
  TextBox1.SetFocus
  TextBox1 = ""
  TextBox1.Tag = ""
End Sub

Private Sub my_proc(i As Long)
   ActiveCell = i
   If ActiveCell.Row < 65536 Then
      ActiveCell.Offset(1, 0).Activate
      ElseIf ActiveCell.Column < 256 Then
      Cells(1, ActiveCell.Column + 1).Activate
      Else
      MsgBox "Letzte Zelle erreicht!"
      UserForm_Terminate
      End If
End Sub

Private Sub my_proc_s(i As Long)
   ActiveCell = i
   If ActiveCell.Row < (sr + srs - 1) Then
      ActiveCell.Offset(1, 0).Activate
      ElseIf ActiveCell.Column < (sc + scs - 1) Then
      Cells(sr, ActiveCell.Column + 1).Activate
      Else
      MsgBox "Letzte Zelle erreicht!"
      UserForm_Terminate
      End If
End Sub

Private Sub UserForm_Terminate()
Range(Cells(sr, sc), Cells(sr + srs - 1, sc + scs - 1)).Select
UserForm1.Hide
End Sub