|
Ansicht des Beitrags:
Hallo Herr Alter Dresdner
hier kommt der Code von meiner UserForm Mitglieder
Option Explicit
Private Sub CommandButton_Austritt_Exit(ByVal Cancel As MSForms.ReturnBoolean)
CommandButton_Austritt.BackColor = vbWhite
End Sub
Private Sub CommandButton_Löschen_Exit(ByVal Cancel As MSForms.ReturnBoolean)
CommandButton_Löschen.BackColor = vbWhite
End Sub
Private Sub CommandButton_Löschen_Enter()
CommandButton_Löschen.BackColor = vbMagenta
End Sub
Private Sub CommandButton_Austritt_Enter()
CommandButton_Austritt.BackColor = vbCyan
End Sub
Private Sub CommandButton_Löschen_Click()
Dim Zeile As Integer
Select Case MsgBox("Willlst du das Mitglied" & " " & TextBox3 & " " & "löschen", vbYesNo + vbQuestion, "Warnung")
Case vbYes
With Worksheets("Mitglieder")
Zeile = UserForm1.ListBox1.ListIndex + 2
.Range("A" & Zeile) = TextBox1
.Range("B" & Zeile) = TextBox2
.Range("C" & Zeile) = TextBox3
.Range("D" & Zeile) = TextBox4
.Range("E" & Zeile) = TextBox5
.Range("F" & Zeile) = TextBox6
.Range("G" & Zeile) = TextBox7
.Range("H" & Zeile) = TextBox8
.Range("I" & Zeile) = TextBox9
.Range("J" & Zeile) = TextBox10
.Range("K" & Zeile) = TextBox11
.Range("L" & Zeile) = TextBox17
.Range("M" & Zeile) = TextBox12
.Range("N" & Zeile) = TextBox13
.Range("O" & Zeile) = TextBox14
End With
If ListBox1.ListIndex >= 0 Then 'Kopieren
Tabelle1.Rows(Range("A2:N100").Row + ListBox1.ListIndex).Copy Destination:=ThisWorkbook.Worksheets("Austritt").Range("A65536").End(xlUp).Offset(1, 0)
End If
If ListBox1.ListIndex >= 0 Then 'Löschen
Tabelle1.Rows(Range("A2:N100").Row + ListBox1.ListIndex).Delete Shift:=xlShiftUp
End If
Me.TextBox1.Text = ""
Me.TextBox2.Text = ""
Me.TextBox3.Text = ""
Me.TextBox4.Text = ""
Me.TextBox5.Text = ""
Me.TextBox6.Text = ""
Me.TextBox7.Text = ""
Me.TextBox8.Text = ""
Me.TextBox9.Text = ""
Me.TextBox10.Text = ""
Me.TextBox11.Text = ""
Me.TextBox12.Text = ""
Me.TextBox13.Text = ""
Me.TextBox14.Text = ""
Me.MultiPage1.Value = 0
Case vbNo
MsgBox "Versuche es neu!"
End Select
End Sub
Private Sub CommandButton_Schliessen_Click()
Unload Me
End Sub
Private Sub CommandButton_Speichern_1_Click()
Call neuesProdukt
End Sub
Private Sub CommandButton_Speichern_2_Enter()
CommandButton_Speichern_2.BackColor = vbYellow
End Sub
Private Sub CommandButton_Speichern_2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
CommandButton_Speichern_2.BackColor = vbWhite
End Sub
Private Sub CommandButton2_Click()
Call kopieren_filtern
End Sub
Private Sub MultiPage1_Click(ByVal Index As Long) 'Starten Page1
If Index = 1 Then
Dim dblMAX As Double
With Tabelle5
dblMAX = Application.Max(.Range(.Cells(2, 1), .Cells(.Rows.count, 1).End(xlUp))) + 1 'ermitteln letzte Mitg Nr +1
End With
TextBox_MitgNr.Value = dblMAX 'in Textbox schreiben
TextBox_Vorname.SetFocus 'starten zum Eintragen in TextBox
End If
End Sub
Private Sub TextBox_Geb_AfterUpdate()
Dim Alter As Integer
Dim GebDatum As Date
If IsDate(TextBox_Geb) Then
GebDatum = CDate(TextBox_Geb)
TextBox_Geb = Format(TextBox_Geb, "dd.mm.yyyy")
Alter = Year(Date) - Year(GebDatum)
If DateSerial(Year(Date), Month(GebDatum), Day(GebDatum)) > Date Then Alter = Alter - 1
Me.TextBox_Alter = Alter
ElseIf TextBox_Geb = "" Then
Exit Sub
Else
MsgBox "Textbox_Geb enthält kein gültiges Datum !", vbExclamation
End If
End Sub
Private Sub TextBox_MitgNr_Change()
'Mitgliedsnummer neu berechnen
Dim Zahl As Variant
ThisWorkbook.Worksheets("Mitglieder").Activate
Zahl = Application.WorksheetFunction.Max(Range("A:A")) + 1
'MsgBox "Die neue Mitgliedsnummer ist:-" & Zahl
Me.TextBox_MitgNr.Text = Zahl
End Sub
Private Sub TextBox3_AfterUpdate()
'If IsDate(TextBox3)Then = Format(TextBox3.Value, "dd.mm.yyyy")
If IsDate(TextBox3) Then TextBox3 = Format(TextBox3, "TT.MM.JJJJ")
End Sub
Private Sub TextBox3_Change()
TextBox3 = Format(TextBox3.Value, "dd.mm.yyyy")
End Sub
Private Sub TextBox17_Change()
End Sub
Private Sub UserForm_Initialize()
Dim Zahl As Variant
Dim dblMAX As Integer
MultiPage1.Value = 0 'Für die erste Seite
Me.MultiPage1.Style = fmTabStyleButtons
Worksheets("Akt_Mitglieder").Activate
With Me.ListBox1
.ColumnHeads = True
.ColumnCount = 3
.ColumnWidths = "40;80;100"
.RowSource = "=Akt_Mitglieder!A2:Q100"
.MultiSelect = fmMultiSelectSingle
.TextColumn = 2
.BorderColor = 1
'.BoundColumn = 4
End With
'TextBox3 = Format(CDate(TextBox3.Value), "dd.mm.yyyy")
TextBox3.Value = Format(Date, "DD.MM.YYYY")
TextBox11.Text = Format(Date, "DD.MM.YYYY")
Image1.Picture = LoadPicture("C:\Users\User\Pictures\Freundkreis.jpg") '..\..\Pictures\Freundkreis.jpg
Image1.PictureSizeMode = fmPictureSizeModeStretch
Image3.Picture = LoadPicture("C:\Users\User\Pictures\Hände_1jpg.jpg") '..\..\Pictures\Hände.jpg
Image3.PictureSizeMode = fmPictureSizeModeStretch
Image2.Picture = LoadPicture("C:\Users\User\Pictures\Kinder.jpg") 'Pictures\Kinder.jpg
Image2.PictureSizeMode = fmPictureSizeModeStretch
End Sub
Private Sub CommandButton1_Click() 'hier Klick
On Error GoTo Fehlerverarbeitung
Me.Label20.Caption = ListBox1.List(ListBox1.ListIndex, 0)
Me.Label21.Caption = ListBox1.List(ListBox1.ListIndex, 1)
Me.Label22.Caption = ListBox1.List(ListBox1.ListIndex, 2)
Me.Label23.Caption = ListBox1.List(ListBox1.ListIndex, 3)
Me.Label24.Caption = ListBox1.List(ListBox1.ListIndex, 4)
Me.Label26.Caption = ListBox1.List(ListBox1.ListIndex, 5)
Me.Label28.Caption = ListBox1.List(ListBox1.ListIndex, 6)
Me.Label29.Caption = ListBox1.List(ListBox1.ListIndex, 7)
Me.Label32.Caption = ListBox1.List(ListBox1.ListIndex, 8)
Me.Label33.Caption = ListBox1.List(ListBox1.ListIndex, 9)
Me.Label35.Caption = ListBox1.List(ListBox1.ListIndex, 10)
Me.Label36.Caption = ListBox1.List(ListBox1.ListIndex, 11)
Me.Label37.Caption = ListBox1.List(ListBox1.ListIndex, 12)
Me.Label38.Caption = ListBox1.List(ListBox1.ListIndex, 13)
Me.Label71.Caption = ListBox1.List(ListBox1.ListIndex, 14)
Me.Label74.Caption = ListBox1.List(ListBox1.ListIndex, 15)
'Me.Label74.Caption = ListBox1.List(ListBox1.ListIndex, 16)
'Me.Label74.Caption = ListBox1.List(ListBox1.ListIndex, 17)
Me.MultiPage1.Pages(2).TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 0)
Me.MultiPage1.Pages(2).TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 1)
Me.MultiPage1.Pages(2).TextBox3.Value = ListBox1.List(ListBox1.ListIndex, 2)
Me.MultiPage1.Pages(2).TextBox4.Value = ListBox1.List(ListBox1.ListIndex, 3)
Me.MultiPage1.Pages(2).TextBox5.Value = ListBox1.List(ListBox1.ListIndex, 4)
Me.MultiPage1.Pages(2).TextBox6.Value = ListBox1.List(ListBox1.ListIndex, 5)
Me.MultiPage1.Pages(2).TextBox7.Value = ListBox1.List(ListBox1.ListIndex, 6)
Me.MultiPage1.Pages(2).TextBox8.Value = ListBox1.List(ListBox1.ListIndex, 7)
Me.MultiPage1.Pages(2).TextBox9.Value = ListBox1.List(ListBox1.ListIndex, 8)
Me.MultiPage1.Pages(2).TextBox10.Value = ListBox1.List(ListBox1.ListIndex, 9)
Me.MultiPage1.Pages(2).TextBox11.Value = ListBox1.List(ListBox1.ListIndex, 10)
Me.MultiPage1.Pages(2).TextBox12.Value = ListBox1.List(ListBox1.ListIndex, 11)
Me.MultiPage1.Pages(2).TextBox13.Value = ListBox1.List(ListBox1.ListIndex, 12)
Me.MultiPage1.Pages(2).TextBox14.Value = ListBox1.List(ListBox1.ListIndex, 13)
Me.MultiPage1.Pages(2).TextBox16.Value = ListBox1.List(ListBox1.ListIndex, 14)
Me.MultiPage1.Pages(2).TextBox15.Value = ListBox1.List(ListBox1.ListIndex, 15)
'Me.MultiPage1.Pages(2).TextBox17.Value = ListBox1.List(ListBox1.ListIndex, 17)
' Me.MultiPage1.Pages(2).TextBox16.Value = ListBox1.List(ListBox1.ListIndex, 17)
Me.MultiPage1.Value = 2
Exit Sub
Fehlerverarbeitung:
' Was tun, wenn ein Laufzeitfehler auftritt
MsgBox "Bitte ein Mitglied in der Listbox ankicken, dann auf Button klick kicken"
End Sub
Private Sub neuesProdukt() 'neues Mitglied
Dim last As Integer
last = Sheets("Mitglieder").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Mitglieder").Cells(last, 1) = CInt(TextBox_MitgNr.Text) 'MitgliedNr
Sheets("Mitglieder").Cells(last, 2) = TextBox_Vorname 'Vorname
Sheets("Mitglieder").Cells(last, 3) = TextBox_Name 'Name
Sheets("Mitglieder").Cells(last, 4) = TextBox_Geb 'geboren
Sheets("Mitglieder").Cells(last, 5) = TextBox_Straße 'Straße
Sheets("Mitglieder").Cells(last, 6) = TextBox_Hausnummer 'Hausnummer
Sheets("Mitglieder").Cells(last, 7) = TextBox_PLZ 'PLZ
Sheets("Mitglieder").Cells(last, 8) = TextBox_Ort 'Ort
Sheets("Mitglieder").Cells(last, 9) = TextBox_Festnetz 'Festnetz
Sheets("Mitglieder").Cells(last, 10) = TextBox_Handy 'Handy
Sheets("Mitglieder").Cells(last, 11) = TextBox_Eintritt 'Eintritt
Sheets("Mitglieder").Cells(last, 13) = TextBox_EMail 'EMail
Sheets("Mitglieder").Cells(last, 14) = TextBox_Anrede 'Anrede
Sheets("Mitglieder").Cells(last, 15) = TextBox_Bemerkung 'Bemerkung
'ActiveSheet.Cells(last, 16).Value = TextBox_Mitgliedjahre 'Mitgliedsjahe
' last = Sheets("Geburtst").Range("A65536").End(xlUp).Offset(1, 0).Row
' Sheets("Geburtst").Cells(last, 1) = CInt(TextBox_MitgNr.Text) 'MitgliedNr
' Sheets("Geburtst").Cells(last, 2) = TextBox_Vorname 'Vorname
' Sheets("Geburtst").Cells(last, 3) = TextBox_Name 'Name
' Sheets("Geburtst").Cells(last, 4) = TextBox_Geb 'geboren
' Sheets("Geburtst").Cells(last, 6) = TextBox_Eintritt 'Eintritt
Me.TextBox_MitgNr.Text = ""
Me.TextBox_Vorname.Text = ""
Me.TextBox_Name.Text = ""
Me.TextBox_Geb.Text = ""
Me.TextBox_Straße.Text = ""
Me.TextBox_Hausnummer.Text = ""
Me.TextBox_PLZ.Text = ""
Me.TextBox_Ort.Text = ""
Me.TextBox_Festnetz.Text = ""
Me.TextBox_Handy.Text = ""
Me.TextBox_Eintritt.Text = ""
Me.TextBox_EMail = ""
Me.TextBox_Anrede.Text = ""
Me.TextBox_Bemerkung.Text = ""
Me.TextBox_Alter.Text = ""
Call SortiereSpalteAufsteigend
Call Markieren_Schriftart
Call Makro21
Me.MultiPage1.Value = 0
'
'Me.TextBox_Vorname.SetFocus
End Sub
Private Sub CommandButton_Speichern_2_Click() 'Änderung
'Mitglied Änderen in Tabellen Blätter
Dim Zeile As Integer
With Worksheets("Mitglieder")
Zeile = UserForm1.ListBox1.ListIndex + 2
.Range("A" & Zeile) = CInt(TextBox1.Text)
.Range("B" & Zeile) = TextBox2
.Range("C" & Zeile) = TextBox3
.Range("D" & Zeile) = TextBox4
.Range("E" & Zeile) = TextBox5
.Range("F" & Zeile) = TextBox6
.Range("G" & Zeile) = TextBox7
.Range("H" & Zeile) = TextBox8
.Range("I" & Zeile) = TextBox9
.Range("J" & Zeile) = TextBox10
.Range("K" & Zeile) = TextBox11
.Range("L" & Zeile) = TextBox12
.Range("M" & Zeile) = TextBox13
.Range("N" & Zeile) = TextBox14
'.Range("O" & Zeile) = TextBox14
End With
With Worksheets("Akt_Mitglieder")
Zeile = UserForm1.ListBox1.ListIndex + 2
.Range("A" & Zeile) = CInt(TextBox1.Text)
.Range("B" & Zeile) = TextBox2
.Range("C" & Zeile) = TextBox3
.Range("D" & Zeile) = TextBox4
.Range("E" & Zeile) = TextBox5
.Range("F" & Zeile) = TextBox6
.Range("G" & Zeile) = TextBox7
.Range("H" & Zeile) = TextBox8
.Range("I" & Zeile) = TextBox9
.Range("J" & Zeile) = TextBox10
.Range("K" & Zeile) = TextBox11
.Range("L" & Zeile) = TextBox12
.Range("M" & Zeile) = TextBox13
.Range("N" & Zeile) = TextBox14
'.Range("O" & Zeile) = TextBox14
End With
Me.TextBox1.Text = ""
Me.TextBox2.Text = ""
Me.TextBox3.Text = ""
Me.TextBox4.Text = ""
Me.TextBox5.Text = ""
Me.TextBox6.Text = ""
Me.TextBox7.Text = ""
Me.TextBox8.Text = ""
Me.TextBox9.Text = ""
Me.TextBox10.Text = ""
Me.TextBox11.Text = ""
Me.TextBox12.Text = ""
Me.TextBox13.Text = ""
Me.TextBox14.Text = ""
Me.TextBox15.Text = ""
Me.TextBox16.Text = ""
Me.Label20.Caption = ""
Me.Label21.Caption = ""
Me.Label22.Caption = ""
Me.Label23.Caption = ""
Me.Label24.Caption = ""
Me.Label26.Caption = ""
Me.Label28.Caption = ""
Me.Label29.Caption = ""
Me.Label32.Caption = ""
Me.Label33.Caption = ""
Me.Label35.Caption = ""
'Me.Label36.Caption = ListBox1.List(ListBox1.ListIndex, 11)
Me.Label36.Caption = ""
Me.Label37.Caption = ""
Me.Label38.Caption = ""
Me.Label74.Caption = ""
Me.Label71.Caption = ""
Me.MultiPage1.Value = 0
End Sub
Private Sub CommandButton_Austritt_Click()
Dim Zeile As Integer
Dim Datum As String
Datum = Me.TextBox17
If IsDate(Datum) Then
MsgBox "Datum: " & Format(Datum, "DD.MM.YYYY")
With Worksheets("Mitglieder")
Zeile = UserForm1.ListBox1.ListIndex + 2
.Range("A" & Zeile) = TextBox1
.Range("B" & Zeile) = TextBox2
.Range("C" & Zeile) = TextBox3
.Range("D" & Zeile) = TextBox4
.Range("E" & Zeile) = TextBox5
.Range("F" & Zeile) = TextBox6
.Range("G" & Zeile) = TextBox7
.Range("H" & Zeile) = TextBox8
.Range("I" & Zeile) = TextBox9
.Range("J" & Zeile) = TextBox10
.Range("K" & Zeile) = TextBox11
.Range("L" & Zeile) = TextBox17
.Range("M" & Zeile) = TextBox12
.Range("N" & Zeile) = TextBox13
.Range("O" & Zeile) = TextBox14
End With
If ListBox1.ListIndex >= 0 Then 'Kopieren
Tabelle1.Rows(Range("A2:O100").Row + ListBox1.ListIndex).Copy Destination:=ThisWorkbook.Worksheets("Austritt").Range("A65536").End(xlUp).Offset(1, 0)
End If
If ListBox1.ListIndex >= 0 Then 'Löschen
Tabelle1.Rows(Range("A2:N100").Row + ListBox1.ListIndex).Delete Shift:=xlShiftUp
End If
Me.TextBox1.Text = ""
Me.TextBox2.Text = ""
Me.TextBox3.Text = ""
Me.TextBox4.Text = ""
Me.TextBox5.Text = ""
Me.TextBox6.Text = ""
Me.TextBox7.Text = ""
Me.TextBox8.Text = ""
Me.TextBox9.Text = ""
Me.TextBox10.Text = ""
Me.TextBox11.Text = ""
Me.TextBox12.Text = ""
Me.TextBox13.Text = ""
Me.TextBox14.Text = ""
Me.Label20.Caption = ""
Me.Label21.Caption = ""
Me.Label22.Caption = ""
Me.Label23.Caption = ""
Me.Label24.Caption = ""
Me.Label26.Caption = ""
Me.Label28.Caption = ""
Me.Label29.Caption = ""
Me.Label32.Caption = ""
Me.Label33.Caption = ""
Me.Label35.Caption = ""
Me.Label36.Caption = ""
Me.Label37.Caption = ""
Me.Label38.Caption = ""
Else
MsgBox Datum & " ist kein Datum!"
End If
End Sub
|