23.03.2023, 09:49
Hallo,
ich habe eine Frage zu meiner Userform.
Mit der Userform soll das jeweils aktive Blatt in der dynamischen Tabelle befüllt werden.
Es erscheinen jedoch in den Textboxen weder eine Vorschau, wie der Eintrag aussehen soll (zu überschreibender Mustereintrag), noch trägt es die erfassten Daten in die jeweiligen Spalten ein.
Kann mir wer helfen? Wo muss ich noch Was eintragen?
Die erste Zeile ist Zeile 3, die erste Spalte ist Spalte B.
'Dateneingabefelder
Private Sub CommandButtonErfassen_Click()
'Erste freie Zeile ausfindig machen
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'TextBoxDatumBeginn
Cells(last, 2).Value = TextBox_TextBoxDatumBeginn
Cells(last, 3).Value = TextBox_TextBoxDatumEnde
Cells(last, 4).Value = TextBox_TextBoxZeitBeginn
Cells(last, 5).Value = TextBox_TextBoxZeitEnde
Cells(last, 6).Value = TextBox_TextBoxBesucher
Cells(last, 7).Value = TextBox_TextBoxWas
Cells(last, 8).Value = TextBox_TextBoxWo
Cells(last, 9).Value = TextBox_TextBoxWer
End Sub
'Eingabe abbrechen
Private Sub CommandButtonVerwerfen_Click()
Unload Me
End Sub
'Neues Blatt Führungen
Private Sub FuehrungNeu_Click()
Dim BlattName As String
Dim wks As Worksheet
BlattName = InputBox("Für welches Jahr?", "Führungen anlegen")
If BlattName <> "" Then
If BlattName Like "####" Then '4 Ziffern
BlattName = "Führungen " & BlattName
On Error Resume Next
Set wks = Worksheets(BlattName)
On Error GoTo 0
If wks Is Nothing Then
Sheets("Führungen Neu").Copy After:=Sheets(3)
ActiveSheet.Name = BlattName
Else
MsgBox "Das Blatt " & BlattName & " gibt es schon!", , "Fehler"
End If
Else
MsgBox "Der Name ist ungültig", , "Fehler"
End If
End If
End Sub
'Abfrage des Jahres Hospitationen
Private Sub HospitationNeu_Click()
Dim BlattName As String
Dim wks As Worksheet
BlattName = InputBox("Für welches Jahr?", "Hospitationen anlegen")
If BlattName <> "" Then
If BlattName Like "####" Then '4 Ziffern
BlattName = "Hospitationen " & BlattName
On Error Resume Next
Set wks = Worksheets(BlattName)
On Error GoTo 0
If wks Is Nothing Then
Sheets("Hospitationen Neu").Copy After:=Sheets(3)
ActiveSheet.Name = BlattName
Else
MsgBox "Das Blatt " & BlattName & " gibt es schon!", , "Fehler"
End If
Else
MsgBox "Der Name ist ungültig", , "Fehler"
End If
End If
End Sub
'Navigationsblatt aktualisieren
Private Sub Navigation_Click()
'Blatt Navigation neu befüllen
'Sub Navigation()
Dim lngRow As Long
Dim wks As Worksheet
lngRow = 12
With Worksheets("Navigation")
.Range("d13:d50").ClearContents
For Each wks In Worksheets
If wks.Name <> .Name Then
lngRow = lngRow + 1
.Hyperlinks.Add .Cells(lngRow, 4), "", "'" & wks.Name & "'!A1", , wks.Name
End If
Next
End With
Sheets("Navigation").Select
Worksheets("Navigation").Range("D13").Activate
End Sub
'Blatt Navigation neu befüllen Teil 2
Private Sub Worksheet_Activate()
Call Navigation
End Sub
'Textfeld Gast
Private Sub TextBoxBesucher_Change()
End Sub
'Textfeld Datum von
Private Sub TextBoxDatumBeginn_Change()
End Sub
'Textfeld Datum bis
Private Sub TextBoxDatumEnde_Change()
End Sub
'Textfeld Art
Private Sub TextBoxWas_Change()
End Sub
'Textfeld Durchführender
Private Sub TextBoxWer_Change()
End Sub
'Textfeld Ort
Private Sub TextBoxWo_Change()
End Sub
'Textfeld Durchführender
Private Sub TextBoxZeitBeginn_Change()
End Sub
Private Sub TextBoxZeitEnde_Change()
End Sub
Private Sub UserForm_Click()
End Sub
'Abfragefelder Vorgabe
Private Sub UserForm_Initialize()
'TextBoxDatumBeginn
TextBox_DatumBeginn = "Datum eingeben"
'TextBoxDatumEnde
TextBox_DatumEnde = "Datum eingeben"
'TextBoxZeitBeginn
TextBox_ZeitBeginn = "Zeit eingeben"
'TextBoxZeitEnde
TextBox_ZeitEnde = "Zeit eingeben"
'TextBoxBesucher
TextBox_Besucher = "Namen eingeben"
'TextBoxWas
TextBox_Was = "Führung oder/und Hospitation eingeben"
'TextBoxWo
TextBox_Wo = "Örtlichkeit eingeben"
'TextBoxWer
TextBox_Wer = "Dürchführenden eingeben"
End Sub
'Problemerklärung
'CommandButtonErfassen : Beim Anklicken sollen die Daten der Eingabemaske in die jeweiligen Zellen
'des aktiven Arbeitsblatts eingetragen werden.
'Die Abfragefelder nehmen die vorgegebenen Texte aus der UserForm_Initialize nicht an und bleiben
'immer weiß
Gruß
Bernie
ich habe eine Frage zu meiner Userform.
Mit der Userform soll das jeweils aktive Blatt in der dynamischen Tabelle befüllt werden.
Es erscheinen jedoch in den Textboxen weder eine Vorschau, wie der Eintrag aussehen soll (zu überschreibender Mustereintrag), noch trägt es die erfassten Daten in die jeweiligen Spalten ein.
Kann mir wer helfen? Wo muss ich noch Was eintragen?
Die erste Zeile ist Zeile 3, die erste Spalte ist Spalte B.
'Dateneingabefelder
Private Sub CommandButtonErfassen_Click()
'Erste freie Zeile ausfindig machen
Dim last As Integer
last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'TextBoxDatumBeginn
Cells(last, 2).Value = TextBox_TextBoxDatumBeginn
Cells(last, 3).Value = TextBox_TextBoxDatumEnde
Cells(last, 4).Value = TextBox_TextBoxZeitBeginn
Cells(last, 5).Value = TextBox_TextBoxZeitEnde
Cells(last, 6).Value = TextBox_TextBoxBesucher
Cells(last, 7).Value = TextBox_TextBoxWas
Cells(last, 8).Value = TextBox_TextBoxWo
Cells(last, 9).Value = TextBox_TextBoxWer
End Sub
'Eingabe abbrechen
Private Sub CommandButtonVerwerfen_Click()
Unload Me
End Sub
'Neues Blatt Führungen
Private Sub FuehrungNeu_Click()
Dim BlattName As String
Dim wks As Worksheet
BlattName = InputBox("Für welches Jahr?", "Führungen anlegen")
If BlattName <> "" Then
If BlattName Like "####" Then '4 Ziffern
BlattName = "Führungen " & BlattName
On Error Resume Next
Set wks = Worksheets(BlattName)
On Error GoTo 0
If wks Is Nothing Then
Sheets("Führungen Neu").Copy After:=Sheets(3)
ActiveSheet.Name = BlattName
Else
MsgBox "Das Blatt " & BlattName & " gibt es schon!", , "Fehler"
End If
Else
MsgBox "Der Name ist ungültig", , "Fehler"
End If
End If
End Sub
'Abfrage des Jahres Hospitationen
Private Sub HospitationNeu_Click()
Dim BlattName As String
Dim wks As Worksheet
BlattName = InputBox("Für welches Jahr?", "Hospitationen anlegen")
If BlattName <> "" Then
If BlattName Like "####" Then '4 Ziffern
BlattName = "Hospitationen " & BlattName
On Error Resume Next
Set wks = Worksheets(BlattName)
On Error GoTo 0
If wks Is Nothing Then
Sheets("Hospitationen Neu").Copy After:=Sheets(3)
ActiveSheet.Name = BlattName
Else
MsgBox "Das Blatt " & BlattName & " gibt es schon!", , "Fehler"
End If
Else
MsgBox "Der Name ist ungültig", , "Fehler"
End If
End If
End Sub
'Navigationsblatt aktualisieren
Private Sub Navigation_Click()
'Blatt Navigation neu befüllen
'Sub Navigation()
Dim lngRow As Long
Dim wks As Worksheet
lngRow = 12
With Worksheets("Navigation")
.Range("d13:d50").ClearContents
For Each wks In Worksheets
If wks.Name <> .Name Then
lngRow = lngRow + 1
.Hyperlinks.Add .Cells(lngRow, 4), "", "'" & wks.Name & "'!A1", , wks.Name
End If
Next
End With
Sheets("Navigation").Select
Worksheets("Navigation").Range("D13").Activate
End Sub
'Blatt Navigation neu befüllen Teil 2
Private Sub Worksheet_Activate()
Call Navigation
End Sub
'Textfeld Gast
Private Sub TextBoxBesucher_Change()
End Sub
'Textfeld Datum von
Private Sub TextBoxDatumBeginn_Change()
End Sub
'Textfeld Datum bis
Private Sub TextBoxDatumEnde_Change()
End Sub
'Textfeld Art
Private Sub TextBoxWas_Change()
End Sub
'Textfeld Durchführender
Private Sub TextBoxWer_Change()
End Sub
'Textfeld Ort
Private Sub TextBoxWo_Change()
End Sub
'Textfeld Durchführender
Private Sub TextBoxZeitBeginn_Change()
End Sub
Private Sub TextBoxZeitEnde_Change()
End Sub
Private Sub UserForm_Click()
End Sub
'Abfragefelder Vorgabe
Private Sub UserForm_Initialize()
'TextBoxDatumBeginn
TextBox_DatumBeginn = "Datum eingeben"
'TextBoxDatumEnde
TextBox_DatumEnde = "Datum eingeben"
'TextBoxZeitBeginn
TextBox_ZeitBeginn = "Zeit eingeben"
'TextBoxZeitEnde
TextBox_ZeitEnde = "Zeit eingeben"
'TextBoxBesucher
TextBox_Besucher = "Namen eingeben"
'TextBoxWas
TextBox_Was = "Führung oder/und Hospitation eingeben"
'TextBoxWo
TextBox_Wo = "Örtlichkeit eingeben"
'TextBoxWer
TextBox_Wer = "Dürchführenden eingeben"
End Sub
'Problemerklärung
'CommandButtonErfassen : Beim Anklicken sollen die Daten der Eingabemaske in die jeweiligen Zellen
'des aktiven Arbeitsblatts eingetragen werden.
'Die Abfragefelder nehmen die vorgegebenen Texte aus der UserForm_Initialize nicht an und bleiben
'immer weiß
Gruß
Bernie