Wert von Userform wird nicht übergeben
08.12.2018 15:21:14
Userform
Am Ende wird ein neues Formlar geöffnet, nämlich das Formular frm_FrMitglied.
dort soll aus der ersten Userform die Mitgliedsnummer übergeben und dort auf dem Label Mitgliedsnummer gleich mit angezeigt werden. Irgendwie funktioniert das nicht.
(Achtung: Beim Testen, habe die Öffnungsroutine erst in der Schleife für nochnicht vorhandenes Mitglied drin, das heißt, man müsste händisch aus der Tabelle die erste Mitgliedernummer wieder löschen, damit der Aufruf des zweiten Formulars funktioniert, bei weiteren Mitgliedern baue ich erst ein wenn es funktioniert.
Wie gesagt, die Übergabe der Mitgliedsnummer funktioniert nicht:
Hier die Codes der Userformen.
Code der Userform frm_NeuesMitglied
Option Explicit
Dim ws As Worksheet
Dim intLetzteZeile As Integer, intLetzteSpalte As Integer, intMitgliedsnummerNeu As Integer, intMitgliedsnummerAlt As Integer
Dim strMessagebox As String
Const cErsteZeile As Byte = 8, cErsteMitgliedsnummer As Integer = 1, cTabellenÜberschrift As Byte = 7
Private Sub cmb_Close_Click()
Unload Me
End Sub
Private Sub cmb_FrMitglied_Click()
On Error GoTo err:
'Variablen festlegen
Set ws = ThisWorkbook.Worksheets("Mitgliederliste")
intLetzteZeile = ws.Cells(Rows.Count, 2).End(xlUp).Row
intLetzteSpalte = ws.Cells(cTabellenÜberschrift, Columns.Count).End(xlToLeft).Column
'Kontrolle für Programmierer
'MsgBox "Es sind folgende Variablen deklariert: " & vbCrLf & "Tabellenname: " & ws.Name _
'& vbCrLf & "Anzahl ermittlter Zeilen: " & intLetzteZeile & vbCrLf & "Anzahl ermittelter _
Spalten: " & intLetzteSpalte
'Prüfen ob schon ein Mitglied vorhanden ist.
intLetzteZeile = intLetzteZeile + 1
If cErsteZeile = intLetzteZeile Then
'Wenn noch kein Mitglied vorhanden
intMitgliedsnummerNeu = cErsteMitgliedsnummer 'Erste Mitgliedsnummer festlegen
strMessagebox = MsgBox("Es ist noch kein Mitglied vorhanden!" & vbCrLf & vbCrLf _
& "Soll ein neues Mitglied mit der Mitgliedsnummer: FR-" & Format(intMitgliedsnummerNeu, " _
0000") _
& " erstellt werden?", vbInformation + vbYesNoCancel, strVereinsname)
'Auswahl der Messagebox
Select Case strMessagebox
Case Is = 6 'Ja
Call ZeileNachUnten
With ws.Cells(intLetzteZeile, 2)
.Value = intMitgliedsnummerNeu
.NumberFormat = "FR-" & "0000"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Unload Me
'Mitgliedsnummer an neues Formular übergeben
With frm_FrMitglied
.MitgliedsnummerNeu = intMitgliedsnummerNeu
.Show
End With
Case Is = 7 'Nein
MsgBox "Es wird kein Mitglied angelegt," & vbCrLf & vbCrLf & "Formular wird jetzt _
geschlossen", _
vbCritical + vbOKOnly, strVereinsname
Unload Me
Case Else 'Abbrechen
MsgBox "Formular wird jetzt geschlossen", vbExclamation + vbOKOnly, strVereinsname
Unload Me
End Select
Else
'Wenn schon ein Mitglied vorhanden ist
intMitgliedsnummerAlt = ws.Cells(intLetzteZeile, 2).Offset(-1, 0).Value ' Vorhande _
Mitgliedsnummer in Variable schreiben
intMitgliedsnummerNeu = intMitgliedsnummerAlt + 1 'Neu Mitgliedsnummer vergeben
strMessagebox = MsgBox("Soll ein neues Mitglied mit der Mitgliedsnummer: FR-" _
& Format(intMitgliedsnummerNeu, "0000") & " erstellt werden?", vbInformation + _
vbYesNoCancel, _
strVereinsname)
Select Case strMessagebox
Case Is = 6 'Ja
Call ZeileNachUnten
With ws.Cells(intLetzteZeile, 2)
.Value = intMitgliedsnummerNeu
.NumberFormat = "FR-" & "0000"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Unload Me
Case Is = 7 'Nein
MsgBox "Es wird kein Mitglied angelegt," & vbCrLf & vbCrLf & "Formular wird jetzt _
geschlossen", _
vbCritical + vbOKOnly, strVereinsname
Unload Me
Case Else 'Abbrechen
MsgBox "Formular wird jetzt geschlossen", vbExclamation + vbOKOnly, strVereinsname
Unload Me
With frm_FrMitglied
.MitgliedsnummerNeu = intMitgliedsnummerNeu
.Show
End With
End Select
End If
Exit Sub
err:
'Fehlerbehandlung allgemein
MsgBox "Es ist der Fehler mit der Nummer: " & err.Number _
& " und der Beschreibung:" & vbCrLf & err.Description _
& " aufgetreten", vbOKOnly + vbExclamation, strFehlerInfo
End Sub
Private Sub UserForm_Initialize()
On Error GoTo err
'Grafische Aufbereitung des Formulares
Call BoxenFormularTexte
Me.Caption = strVereinsname
With Me.lbl_Support
.BackColor = vbYellow
.ForeColor = vbRed
.Caption = "Bei technischen Fehlern oder Fragen bitte per Mail an den Entwickler!" & _
vbCrLf & vbCrLf & strCopywright _
& strEntwicklerFirma & vbCrLf & strEntwicklerAdresse & vbCrLf & strEntwicklerMail & _
vbCrLf & strEntwicklerUrl
End With
With Me.cmb_FrMitglied
.BackColor = vbYellow
.ForeColor = vbBlue
End With
With Me.cmb_Ehren
.BackColor = vbYellow
.ForeColor = vbBlue
End With
With Me.cmb_TSG
.BackColor = vbYellow
.ForeColor = vbBlue
End With
With Me.cmb_Close
.BackColor = vbYellow
.ForeColor = vbBlue
End With
Exit Sub
err:
'Fehlerbehandlung allgemein
MsgBox "Es ist der Fehler mit der Nummer: " & err.Number _
& " und der Beschreibung:" & vbCrLf & err.Description _
& " aufgetreten", vbOKOnly + vbExclamation, strFehlerInfo
End Sub
Hier der Code der frm_FrMitglied, wo die Übergabe stattfinden soll
Dim ws As Worksheet
Dim intLetzteZeile As Integer, intLetzteSpalte As Integer, intMitgliedsnummerNeu As Integer, intMitgliedsnummerAlt As Integer
Dim strMessagebox As String
Const cErsteZeile As Byte = 8, cErsteMitgliedsnummer As Integer = 1, cTabellenÜberschrift As Byte = 7
Private Sub cmb_Close_Click()
Unload Me
End Sub
Private Sub cmb_FrMitglied_Click()
On Error GoTo err:
'Variablen festlegen
Set ws = ThisWorkbook.Worksheets("Mitgliederliste")
intLetzteZeile = ws.Cells(Rows.Count, 2).End(xlUp).Row
intLetzteSpalte = ws.Cells(cTabellenÜberschrift, Columns.Count).End(xlToLeft).Column
'Kontrolle für Programmierer
'MsgBox "Es sind folgende Variablen deklariert: " & vbCrLf & "Tabellenname: " & ws.Name _
'& vbCrLf & "Anzahl ermittlter Zeilen: " & intLetzteZeile & vbCrLf & "Anzahl ermittelter _
Spalten: " & intLetzteSpalte
'Prüfen ob schon ein Mitglied vorhanden ist.
intLetzteZeile = intLetzteZeile + 1
If cErsteZeile = intLetzteZeile Then
'Wenn noch kein Mitglied vorhanden
intMitgliedsnummerNeu = cErsteMitgliedsnummer 'Erste Mitgliedsnummer festlegen
strMessagebox = MsgBox("Es ist noch kein Mitglied vorhanden!" & vbCrLf & vbCrLf _
& "Soll ein neues Mitglied mit der Mitgliedsnummer: FR-" & Format(intMitgliedsnummerNeu, " _
0000") _
& " erstellt werden?", vbInformation + vbYesNoCancel, strVereinsname)
'Auswahl der Messagebox
Select Case strMessagebox
Case Is = 6 'Ja
Call ZeileNachUnten
With ws.Cells(intLetzteZeile, 2)
.Value = intMitgliedsnummerNeu
.NumberFormat = "FR-" & "0000"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Unload Me
'Mitgliedsnummer an neues Formular übergeben
With frm_FrMitglied
.MitgliedsnummerNeu = intMitgliedsnummerNeu
.Show
End With
Case Is = 7 'Nein
MsgBox "Es wird kein Mitglied angelegt," & vbCrLf & vbCrLf & "Formular wird jetzt _
geschlossen", _
vbCritical + vbOKOnly, strVereinsname
Unload Me
Case Else 'Abbrechen
MsgBox "Formular wird jetzt geschlossen", vbExclamation + vbOKOnly, strVereinsname
Unload Me
End Select
Else
'Wenn schon ein Mitglied vorhanden ist
intMitgliedsnummerAlt = ws.Cells(intLetzteZeile, 2).Offset(-1, 0).Value ' Vorhande _
Mitgliedsnummer in Variable schreiben
intMitgliedsnummerNeu = intMitgliedsnummerAlt + 1 'Neu Mitgliedsnummer vergeben
strMessagebox = MsgBox("Soll ein neues Mitglied mit der Mitgliedsnummer: FR-" _
& Format(intMitgliedsnummerNeu, "0000") & " erstellt werden?", vbInformation + _
vbYesNoCancel, _
strVereinsname)
Select Case strMessagebox
Case Is = 6 'Ja
Call ZeileNachUnten
With ws.Cells(intLetzteZeile, 2)
.Value = intMitgliedsnummerNeu
.NumberFormat = "FR-" & "0000"
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
End With
Unload Me
Case Is = 7 'Nein
MsgBox "Es wird kein Mitglied angelegt," & vbCrLf & vbCrLf & "Formular wird jetzt _
geschlossen", _
vbCritical + vbOKOnly, strVereinsname
Unload Me
Case Else 'Abbrechen
MsgBox "Formular wird jetzt geschlossen", vbExclamation + vbOKOnly, strVereinsname
Unload Me
With frm_FrMitglied
.MitgliedsnummerNeu = intMitgliedsnummerNeu
.Show
End With
End Select
End If
Exit Sub
err:
'Fehlerbehandlung allgemein
MsgBox "Es ist der Fehler mit der Nummer: " & err.Number _
& " und der Beschreibung:" & vbCrLf & err.Description _
& " aufgetreten", vbOKOnly + vbExclamation, strFehlerInfo
End Sub
Private Sub UserForm_Initialize()
On Error GoTo err
'Grafische Aufbereitung des Formulares
Call BoxenFormularTexte
Me.Caption = strVereinsname
With Me.lbl_Support
.BackColor = vbYellow
.ForeColor = vbRed
.Caption = "Bei technischen Fehlern oder Fragen bitte per Mail an den Entwickler!" & _
vbCrLf & vbCrLf & strCopywright _
& strEntwicklerFirma & vbCrLf & strEntwicklerAdresse & vbCrLf & strEntwicklerMail & _
vbCrLf & strEntwicklerUrl
End With
With Me.cmb_FrMitglied
.BackColor = vbYellow
.ForeColor = vbBlue
End With
With Me.cmb_Ehren
.BackColor = vbYellow
.ForeColor = vbBlue
End With
With Me.cmb_TSG
.BackColor = vbYellow
.ForeColor = vbBlue
End With
With Me.cmb_Close
.BackColor = vbYellow
.ForeColor = vbBlue
End With
Exit Sub
err:
'Fehlerbehandlung allgemein
MsgBox "Es ist der Fehler mit der Nummer: " & err.Number _
& " und der Beschreibung:" & vbCrLf & err.Description _
& " aufgetreten", vbOKOnly + vbExclamation, strFehlerInfo
End Sub
Habe die Datei hier ebenfalls hochgeladen
https://www.herber.de/bbs/user/125970.xlsm