Hallo,
diesmal bin ich in Vorleistung gegangen. Ihr müsstet nur den Code etwas erweitern ;)
Ich packe für die Leute die keine Angst haben Makrodateien zu öffenen die Datei an.
Der Code lautet wie Folgt: (ist mein erster selbstgeschriebener, Bitte nicht lynchen)
Code:
'Button: Anlegen
Private Sub Anlegen_Click()
Cells(6, 1) = Name_Kunde.Text
Cells(6, 2) = BSW_Mixkiste.Text
Cells(8, 1) = Palettenbelegung.Text
Cells(14, 1) = Menge_Sorte1.Text
Cells(15, 1) = Menge_Sorte2.Text
Cells(16, 1) = Menge_Sorte3.Text
Cells(17, 1) = Menge_Sorte4.Text
Cells(14, 2) = Name_Sorte1.Text
Cells(15, 2) = Name_Sorte2.Text
Cells(16, 2) = Name_Sorte3.Text
Cells(17, 2) = Name_Sorte4.Text
Cells(14, 3) = BSW_Sorte1.Text
Cells(15, 3) = BSW_Sorte2.Text
Cells(16, 3) = BSW_Sorte3.Text
Cells(17, 3) = BSW_Sorte4.Text
Exit Sub
Fehler: MsgBox "Eingabe Fehler aufgetreten"
End Sub
'Button: Abbrechen
Private Sub Abbrechen_Click()
Unload Me
End Sub
Der macht auch alles was ich will. Ich möchte jetzt nach den eintragungen, dass mit den Eingaben ein neuer Reiter entsteht der den Namen trägt der in A6 steht.
Der Button der die UF aufruft ist auf der Blanco Datei. Den möchte ich nacher auf einen Übersichtsreiter machen.
Ausserdem sollen alle mit der Userform erstellten Kunden, den Kundennamen und die BSW_Mixkiste auf einem Reiter Stammdaten aufgelistet werden
Ich hoffe ich konnte alles verständlich erklären
MFG
Sven
Hallo Sven,
z.B. so:
'Button: Anlegen
Private Sub Anlegen_Click()
Dim oWsKunde As Worksheet
If Name_Kunde.Text <> "" Then
On Error Resume Next
Set oWsKunde = Worksheets(Name_Kunde.Text)
On Error GoTo 0
If oWsKunde Is Nothing Then
Set oWsKunde = Worksheets.Add(After:=Worksheets(Worksheets.Count))
oWsKunde.Name = Name_Kunde.Text
End If
With oWsKunde
.Cells(6, 1) = Name_Kunde.Text
.Cells(6, 2) = BSW_Mixkiste.Text
.Cells(8, 1) = Palettenbelegung.Text
.Cells(14, 1) = Menge_Sorte1.Text
.Cells(15, 1) = Menge_Sorte2.Text
.Cells(16, 1) = Menge_Sorte3.Text
.Cells(17, 1) = Menge_Sorte4.Text
.Cells(14, 2) = Name_Sorte1.Text
.Cells(15, 2) = Name_Sorte2.Text
.Cells(16, 2) = Name_Sorte3.Text
.Cells(17, 2) = Name_Sorte4.Text
.Cells(14, 3) = BSW_Sorte1.Text
.Cells(15, 3) = BSW_Sorte2.Text
.Cells(16, 3) = BSW_Sorte3.Text
.Cells(17, 3) = BSW_Sorte4.Text
End With
End If
End Sub
Einen Reiter (Tabellenblatt) "Stammdaten" habe ich in Deiner Datei nicht gefunden.
Gruß Uwe
Hallo Uwe,
Ich habe den Code jetz mal so eingefügt. Dabei kommt auch ein neues Tabellenblatt raus mit den EIngaben der Userform.
Aber diese sollen in dem Blanco Reiter eingetragen werden und dann mit dem neuen Namen abgelgt werden.
Der Reiter Stammdaten ist jetzt dabei ist aber nur ein leeres tabellenblatt.
Hba ich was falsch gemacht?
Gruß Sven
(31.01.2019, 08:23)Coprat schrieb: [ -> ]Aber diese sollen in dem Blanco Reiter eingetragen werden und dann mit dem neuen Namen abgelgt werden.
Sorry, hatte versehentlich die erste Version erwischt.
'Button: Anlegen
Private Sub Anlegen_Click()
Dim oWsKunde As Worksheet
If Name_Kunde.Text <> "" Then
On Error Resume Next
Set oWsKunde = Worksheets(Name_Kunde.Text)
If Not oWsKunde Is Nothing Then
oWsKunde.Activate
Else
Application.DisplayAlerts = False
Worksheets("blanco").Copy After:=Worksheets(Worksheets.Count)
Application.DisplayAlerts = True
Set oWsKunde = ActiveSheet
End If
With oWsKunde
.Name = Name_Kunde.Text
.Cells(6, 1) = Name_Kunde.Text
.Cells(6, 2) = BSW_Mixkiste.Text
.Cells(8, 1) = Palettenbelegung.Text
.Cells(14, 1) = Menge_Sorte1.Text
.Cells(15, 1) = Menge_Sorte2.Text
.Cells(16, 1) = Menge_Sorte3.Text
.Cells(17, 1) = Menge_Sorte4.Text
.Cells(14, 2) = Name_Sorte1.Text
.Cells(15, 2) = Name_Sorte2.Text
.Cells(16, 2) = Name_Sorte3.Text
.Cells(17, 2) = Name_Sorte4.Text
.Cells(14, 3) = BSW_Sorte1.Text
.Cells(15, 3) = BSW_Sorte2.Text
.Cells(16, 3) = BSW_Sorte3.Text
.Cells(17, 3) = BSW_Sorte4.Text
End With
End If
On Error GoTo 0
End Sub
(31.01.2019, 08:23)Coprat schrieb: [ -> ]Der Reiter Stammdaten ist jetzt dabei ist aber nur ein leeres tabellenblatt.
Der war richtig gut. :28:
Gruß Uwe
Perfekt danke dir
Jetzt nur noch das die Zelle A8 auf dem Reiter Stammdaten B1 geschrieben wird und die Zelle B8 auf A1
der nächste kunde dann in B2 und A2 usw.
Gruß Sven
(31.01.2019, 10:23)Coprat schrieb: [ -> ]Jetzt nur noch das die Zelle A8 auf dem Reiter Stammdaten B1 geschrieben wird und die Zelle B8 auf A1
der nächste kunde dann in B2 und A2 usw.
Ein bisschen mehr Konzentration beim Verfassen der Beschreibung wäre schon wünschenswert.
Private Sub Anlegen_Click()
Dim oWsKunde As Worksheet
If Name_Kunde.Text <> "" Then
On Error Resume Next
Set oWsKunde = Worksheets(Name_Kunde.Text)
If Not oWsKunde Is Nothing Then
oWsKunde.Activate
Else
With Worksheets("Stammdaten").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).Value = Name_Kunde.Text
.Offset(1, 1).Value = BSW_Mixkiste.Text
End With
Application.DisplayAlerts = False
Worksheets("blanco").Copy After:=Worksheets(Worksheets.Count)
Application.DisplayAlerts = True
Set oWsKunde = ActiveSheet
End If
With oWsKunde
.Name = Name_Kunde.Text
.Cells(6, 1) = Name_Kunde.Text
.Cells(6, 2) = BSW_Mixkiste.Text
.Cells(8, 1) = Palettenbelegung.Text
.Cells(14, 1) = Menge_Sorte1.Text
.Cells(15, 1) = Menge_Sorte2.Text
.Cells(16, 1) = Menge_Sorte3.Text
.Cells(17, 1) = Menge_Sorte4.Text
.Cells(14, 2) = Name_Sorte1.Text
.Cells(15, 2) = Name_Sorte2.Text
.Cells(16, 2) = Name_Sorte3.Text
.Cells(17, 2) = Name_Sorte4.Text
.Cells(14, 3) = BSW_Sorte1.Text
.Cells(15, 3) = BSW_Sorte2.Text
.Cells(16, 3) = BSW_Sorte3.Text
.Cells(17, 3) = BSW_Sorte4.Text
End With
End If
On Error GoTo 0
End Sub
Gruß Uwe