Pflichteingabe in 2 definierte Zellen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Falls ich alles richtig verstanden habe?
Vielleicht hilft dir folgender Code weiter.

' Erstelle eine Userform mit 2 Textboxen (Name: txtZelleA3, txtZelleI3) und
' einem CommandButton (Name: cmdOk)

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, ByVal bEnable As Long) As Long
Dim hwndXL&
Dim PrüfZahl%
Private Sub UserForm_Activate()

   hwndXL = FindWindow("XLMAIN", Application.Caption)
   If hwndXL <> 0 Then
       EnableWindow hwndXL, 0   'Excelfenster sperren
       Application.CellDragAndDrop = False
   End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode = vbFormControlMenu Then
          Cancel = True
    End If
    Application.CellDragAndDrop = False
End Sub
Private Sub cmdok_Click()
' Überprüfen, ob Eingabe erfolgte
    If Len(txtZelleC3) = 0 Or Len(txtZelleI3) = 0 _
    Or IsEmpty(txtZelleC3) Or IsEmpty(txtZelleI3) Then
          MsgBox "Beide Eingabefelder müssen gefüllt werde."
          If Len(txtZelleC3) = 0 Then txtZelleC3.SetFocus Else txtZelleI3.SetFocus
          Exit Sub
    End If
' Überprüfung, ob nur Leerzeichen eingegeben wurden
    Prüfe_Leerzeichen (txtZelleC3)
    If Len(txtZelleC3) = PrüfZahl Then
          MsgBox "Nur Leerzeichen nicht zulässig."
          txtZelleC3.SetFocus
          Exit Sub
    End If
    Prüfe_Leerzeichen (txtZelleI3)
    If Len(txtZelleC3) = PrüfZahl Then
          MsgBox "Nur Leerzeichen nicht zulässig."
          txtZelleI3.SetFocus
          Exit Sub
    End If



      hwndXL = FindWindow("XLMAIN", Application.Caption)

      If hwndXL <> 0 Then
          EnableWindow hwndXL, 1   'Excelfenster entsperren
      End If

      Worksheets("Test").[C3] = txtZelleC3.Value
      Worksheets("Test").[I3] = txtZelleC3.Value

      Application.CellDragAndDrop = True

   Unload Me
End Sub
Bei weiteren Fragen einfach melden.
mfg, GraFri

Hallo
Hatten sich leider 2 kleine Fehler eingeschlichen.

' Erstelle eine Userform mit 2 Textboxen (Name: txtZelleA3, txtZelleI3) und
' einem CommandButton (Name: cmdOk)

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function EnableWindow Lib "user32" _
(ByVal hwnd As Long, ByVal bEnable As Long) As Long
Dim hwndXL&
Dim PrüfZahl%
Private Sub UserForm_Activate()

   hwndXL = FindWindow("XLMAIN", Application.Caption)
   If hwndXL <> 0 Then
       EnableWindow hwndXL, 0   'Excelfenster sperren
       Application.CellDragAndDrop = False
   End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    If CloseMode = vbFormControlMenu Then
          Cancel = True
    End If
    Application.CellDragAndDrop = True
End Sub
Private Sub cmdok_Click()
' Überprüfen, ob Eingabe erfolgte
    If Len(txtZelleC3) = 0 Or Len(txtZelleI3) = 0 _
    Or IsEmpty(txtZelleC3) Or IsEmpty(txtZelleI3) Then
          MsgBox "Beide Eingabefelder müssen gefüllt werde."
          If Len(txtZelleC3) = 0 Then txtZelleC3.SetFocus Else txtZelleI3.SetFocus
          Exit Sub
    End If
' Überprüfung, ob nur Leerzeichen eingegeben wurden
    Prüfe_Leerzeichen (txtZelleC3)
    If Len(txtZelleC3) = PrüfZahl Then
          MsgBox "Nur Leerzeichen nicht zulässig."
          txtZelleC3.SetFocus
          Exit Sub
    End If
    Prüfe_Leerzeichen (txtZelleI3)
    If Len(txtZelleC3) = PrüfZahl Then
          MsgBox "Nur Leerzeichen nicht zulässig."
          txtZelleI3.SetFocus
          Exit Sub
    End If



      hwndXL = FindWindow("XLMAIN", Application.Caption)

      If hwndXL <> 0 Then
          EnableWindow hwndXL, 1   'Excelfenster entsperren
      End If

      Worksheets("Test").[C3] = txtZelleC3.Value
      Worksheets("Test").[I3] = txtZelleI3.Value

      Application.CellDragAndDrop = True

   Unload Me
End Sub

Beliebteste Forumthreads (12 Monate)

Pflichteingabe in 2 definierte Zellen

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Pflichteingabe in 2 definierte Zellen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread