Bräuchte einmal Hilfe bitte
06.02.2019 21:30:37
benny124aka
bin ein ziemlicher VBA Neuling und kann zwar schon einiges nachvollziehen beim selbst schreiben harperts aber noch ein wenig. Mit eurer Hilfe habe ich aber schon einiges hinbekommen. Vielen Dank an dieser Stelle nochmal dafür. (Und ja das geht bestimmt auch einfacher oder schöner/ ich bin aber schon froh wenns funktioniert :D)
Bin auch über jeden Tip zu Literatur, Schulungsmaßnahmen, Ausbildungen, eKurse ....
dankbar.
So nun zu meinem "Problem" :
Ich glaube ganz so viel ist da auch nicht mehr zu verändern.
Kommentare in dem Code beschreiben was passieren soll.
'1Abbruch
Private Sub cmd_abbruch_Click()
Unload frm_Jugendmitgliedhinzufügen
End Sub
'1Löschen mit Bestätigung
Private Sub cmd_löschen_Click()
'1Öffnet eine MsgBox mit einer Abfrage/Bestätigung ob Mitglied wirklich gelöscht werden soll
temp = MsgBox("Soll das Mitglied wirklich gelöscht werden?", vbYesNo)
If temp = vbYes Then
'1Löschen
Sheets("Mitglieder").Rows(Z).Delete
Unload Me
End If
End Sub
'1Fügt die eingetragenen Werte ins Tabellenblatt und schließt die UserForm _ frm_Jugemdmitgliedhinzufügen
Private Sub cmd_save_Click()
Dim sNameBlatt As String
Dim intJ As Integer
Dim bolVorhanden As Boolean
Dim wkb As Workbook, wksNeu As Worksheet
Dim intErsteLeereZeile As Long
Set wkb = ActiveWorkbook
sNameBlatt = Me.cbo_Veranstaltung.Text
If sNameBlatt = "" Then
'Wenn cbo_Veranstaltung=leer dann ;soll in dem Aktiven Arbeitsblatt("Mitglieder") _
gespeichert werden !!!
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _
_
'Hilfe
' temp = MsgBox("Sie haben keinen Veranstaltungstitel eingegeben. Möchten Sie eine neue _
_
Veranstaltung erstellen ?", vbYesNo)
' If temp = vbYes Then Unload.MsgBox + TabStop cbo_Veranstaltung
' If temp = vbNo Then Unload.MsgBox + TabStop cmd_save
GoTo Save 'save= in !!!aktivem!!! TB speichern
End If
'Prüfen, ob TB mit Text aus Combobox schon vorhanden ist
With Me.ListBox_Veranstaltung
For intJ = 0 To .ListCount - 1
If LCase(sNameBlatt) = LCase(.List(intJ, 0)) Then
bolVorhanden = True
Exit For
End If
Next
End With
'Hilfe
' 'falls ja : soll in der letzten Zeile des bereits bestehenden TB´s gespeichert werden + _
_
Userform schließen
If bolVorhanden = True Then
MsgBox "Blatt "" & sNameblatt & "" ist schon vorhanden"
Save:
'bestimmt die erste freie Zeile im Tabelleblatt
intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'txt_Name
ActiveSheet.Cells(intErsteLeereZeile, 1).Value = Me.txt_Name
'txt_Vorname
ActiveSheet.Cells(intErsteLeereZeile, 2).Value = Me.txt_Vorname
'txt_Geburtsdatum
ActiveSheet.Cells(intErsteLeereZeile, 3).Value = Me.txt_Geburtsdatum
'txt_Alter
ActiveSheet.Cells(intErsteLeereZeile, 4).Value = Me.txt_Alter
'txt_Spielklasse
ActiveSheet.Cells(intErsteLeereZeile, 5).Value = Me.txt_Spielklasse
'txt_Ranglisten
ActiveSheet.Cells(intErsteLeereZeile, 6).Value = Me.txt_Ranglisten
'cbo_Geschlecht
ActiveSheet.Cells(intErsteLeereZeile, 7).Value = Me.cbo_Geschlecht
'txt_Straße
ActiveSheet.Cells(intErsteLeereZeile, 8).Value = Me.txt_Straße
'txt_Ort
ActiveSheet.Cells(intErsteLeereZeile, 9).Value = Me.txt_Ort
'txt_Telefonnummer
ActiveSheet.Cells(intErsteLeereZeile, 10).Value = Me.txt_Telefonnummer
'txt_Handy
ActiveSheet.Cells(intErsteLeereZeile, 11).Value = Me.txt_Handy
'txt_Email
ActiveSheet.Cells(intErsteLeereZeile, 12).Value = Me.txt_Email
'txt_Verein
ActiveSheet.Cells(intErsteLeereZeile, 13).Value = Me.txt_Verein
'opt_DoppelJA
'prüft ob opt_DoppelJA ausgewählt wurde ; falls Ja = Doppel = "JA" ; ansonsten "NEIN"
If opt_DoppelJA.Value = True Then
ActiveSheet.Cells(intErsteLeereZeile, 14).Value = "JA"
Else
ActiveSheet.Cells(intErsteLeereZeile, 14).Value = "NEIN"
End If
'cbo_Doppelpartner
ActiveSheet.Cells(intErsteLeereZeile, 15).Value = Me.cbo_Doppelpartner
'prüft ob opt_DoppelNEIN ausgewählt wurde ; falls ja: Doppelpartner = "Kein Doppel"
If opt_DoppelNEIN.Value = True Then
ActiveSheet.Cells(intErsteLeereZeile, 15).Value = "Kein Doppel"
End If
'cbo_Veranstaltung
ActiveSheet.Cells(intErsteLeereZeile, 16).Value = Me.cbo_Veranstaltung
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _
_
' 'txt_weitereMeldungen
' 'ActiveSheet.Cells(intErsteLeereZeile, 17).Value = Me.txt_weitereMeldungen
' 'Welche Konkurenzen wurden gewählt ? Checkboxen
' If chb_CSchüler.Value = True Then Cells(intErsteLeereZeile, 17).Value = chb_CSchüler. _
_
Caption
' If chb_BSchüler.Value = True Then Cells(intErsteLeereZeile, 17).Value = Cells( _
intErsteLeereZeile, 17).Value & " , " chb_BSchüler.Caption
' If chb_ASchüler.Value = True Then Cells(intErsteLeereZeile, 17).Value = Cells( _
intErsteLeereZeile, 17).Value & " , " chb_ASchüler.Caption
' If chb_Jugend.Value = True Then Cells(intErsteLeereZeile, 17).Value = Cells( _
intErsteLeereZeile, 17).Value & " , " chb_Jugend.Caption
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' _
_
'txt_zumTTgekommen
ActiveSheet.Cells(intErsteLeereZeile, 18).Value = Me.txt_zumTTgekommen
Unload frm_Jugendmitgliedhinzufügen
Else
'Blatt neu anlegen
wkb.Worksheets.Add after:=wkb.Sheets(wkb.Sheets.Count)
Set wksNeu = wkb.Sheets(wkb.Sheets.Count)
' Wenn ein neues TB angelegt wird soll die Tabelle von Sheets "Mitglieder" ohne Inhalt _
_
kopiert werden
' (nur die Überschriften und das Tabellenformat)
wksNeu.Name = sNameBlatt
'Daten eintragen - Beispiel : .Range("B3") = Me.TextBox1.Value
With wksNeu
'leere Tabelle kopieren
Worksheets("Listen").Range("Tabelle_leer").Copy Destination:=wkb.Sheets(wkb.Sheets. _
Count).Range("A5")
'bestimmt die erste leere zeile
intErsteLeereZeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
'txt_Name
ActiveSheet.Cells(intErsteLeereZeile, 1).Value = Me.txt_Name
'txt_Vorname
ActiveSheet.Cells(intErsteLeereZeile, 2).Value = Me.txt_Vorname
'txt_Geburtsdatum
ActiveSheet.Cells(intErsteLeereZeile, 3).Value = Me.txt_Geburtsdatum
'txt_Alter
ActiveSheet.Cells(intErsteLeereZeile, 4).Value = Me.txt_Alter
'txt_Spielklasse
ActiveSheet.Cells(intErsteLeereZeile, 5).Value = Me.txt_Spielklasse
'txt_Ranglisten
ActiveSheet.Cells(intErsteLeereZeile, 6).Value = Me.txt_Ranglisten
'cbo_Geschlecht
ActiveSheet.Cells(intErsteLeereZeile, 7).Value = Me.cbo_Geschlecht
'txt_Straße
ActiveSheet.Cells(intErsteLeereZeile, 8).Value = Me.txt_Straße
'txt_Ort
ActiveSheet.Cells(intErsteLeereZeile, 9).Value = Me.txt_Ort
'txt_Telefonnummer
ActiveSheet.Cells(intErsteLeereZeile, 10).Value = Me.txt_Telefonnummer
'txt_Handy
ActiveSheet.Cells(intErsteLeereZeile, 11).Value = Me.txt_Handy
'txt_Email
ActiveSheet.Cells(intErsteLeereZeile, 12).Value = Me.txt_Email
'txt_Verein
ActiveSheet.Cells(intErsteLeereZeile, 13).Value = Me.txt_Verein
'opt_DoppelJA
'prüft ob opt_DoppelJA ausgewählt wurde ; falls Ja = Doppel = "JA" ; ansonsten "NEIN"
If opt_DoppelJA.Value = True Then
ActiveSheet.Cells(intErsteLeereZeile, 14).Value = "JA"
Else
ActiveSheet.Cells(intErsteLeereZeile, 14).Value = "NEIN"
End If
'cbo_Doppelpartner
ActiveSheet.Cells(intErsteLeereZeile, 15).Value = Me.cbo_Doppelpartner
'opt_DoppelNEIN
'prüft ob opt_DoppelNEIN ausgewählt wurde ; falls ja = Doppelpartner = "Kein Doppel"
If opt_DoppelNEIN.Value = True Then
ActiveSheet.Cells(intErsteLeereZeile, 15).Value = "Kein Doppel"
End If
'cbo_Veranstaltung
ActiveSheet.Cells(intErsteLeereZeile, 16).Value = Me.cbo_Veranstaltung
'txt_weitereMeldungen
'Welche Konkurenzen wurden gewählt ? Checkboxen nehmen ?
'ActiveSheet.Cells(intErsteLeereZeile, 17).Value = Me.txt_weitereMeldungen
' If chb_CSchüler.Value = True Then Cells(intErsteLeereZeile, 17).Value = chb_CSchüler. _
_
Caption
' If chb_BSchüler.Value = True Then Cells(intErsteLeereZeile, 17).Value = Cells( _
intErsteLeereZeile, 17).Value & " , " chb_BSchüler.Caption
' If chb_ASchüler.Value = True Then Cells(intErsteLeereZeile, 17).Value = Cells( _
intErsteLeereZeile, 17).Value & " , " chb_ASchüler.Caption
' If chb_Jugend.Value = True Then Cells(intErsteLeereZeile, 17).Value = Cells( _
intErsteLeereZeile, 17).Value & " , " chb_Jugend.Caption
'txt_zumTTgekommen
ActiveSheet.Cells(intErsteLeereZeile, 18).Value = Me.txt_zumTTgekommen
Unload frm_Jugendmitgliedhinzufügen
'Listbox aktualisieren
Call prcListbox_fuellen
End With
End If
beenden:
End Sub
Private Sub prcListbox_fuellen()
Dim intJ As Integer
Me.ListBox_Veranstaltung.Clear
With ActiveWorkbook
For intJ = 1 To .Sheets.Count
ListBox_Veranstaltung.AddItem .Sheets(intJ).Name
Next
End With
End Sub
'1Läd eine Liste der Namen in die combobox cbo_Doppelpartner, wenn opt_DoppelJA gewählt wurde
Private Sub opt_DoppelJA_Click()
If opt_DoppelJA = True Then
cbo_Doppelpartner.RowSource = "A5:A" & Sheets("Mitglieder").Cells(Cells.Rows.Count, _
_
1).End(xlUp).Row
cbo_Doppelpartner.ListIndex = 0
End If
End Sub
'1Trägt die vorab programmierten Werte in die Userform frm_Jugemdmitgliedhinzufügen
Private Sub UserForm_Initialize()
'Listbox_Veranstaltung
Call prcListbox_fuellen
With Me
'cbo_Geschlecht
cbo_Geschlecht.AddItem "männlich"
cbo_Geschlecht.AddItem "weiblich"
'cbo_Doppelpartner
cbo_Doppelpartner.AddItem "Zulosen"
cbo_Doppelpartner.AddItem "Kein Doppel"
'opt_DoppelJA
opt_DoppelJA = False
'opt_DoppelNEIN
opt_DoppelNEIN = True
End With
End Sub