AW: Codeerweiterung
27.03.2018 09:52:12
blangmantl
Hallo Karin,
das beim Modul funktioniert perfekt, danke dafür.
Beim Workbook open zeigt er mir jetzt eine Fehlermeldung an, habe ich da ein endif zu wenig? Ich setze den geänderten Code mal rein, bitte sehe mal drüber, was da verkehrt ist.
Private Sub Workbook_Open()
Dim daDatum As Date ' Variable für das Datum
Dim lngZeile As Long ' Variable für die Zeile
Dim strNamen As String ' Variable für die Namen
lngZeile = 4
With Worksheets("Mitgliederliste")
' Schleife so lange durchlaufen bis in Spalte A eine Leerzelle vorhanden ist
Do Until IsEmpty(.Cells(lngZeile, 1))
' nur wenn Spalte R leer
If .Cells(lngZeile, 18) = "" Then
' Spalte N ist nicht leer
If .Cells(lngZeile, 14) "" Then
' Datum aus Spalte N auf die Variable schreiben
daDatum = .Cells(lngZeile, 14)
' Tag aus Spalte N & Monat aus Spalte N & Jahr(Heute) = Datum
If CDate(Day(daDatum) & "." & Month(daDatum) & "." & Year(Date)) = _
Date Then
Monat des Datums in Spalte N = Monat vom aktuellem Datum
If Month(daDatum) = Month(Date) Then
' Alter, Name, Vorname, Status auf Variable schreiben
Select Case .Cells(lngZeile, 22)
Case "Ehrenmitglied"
strNamen = strNamen & .Cells(lngZeile, 19).Text & _
vbTab & .Cells(lngZeile, 3) & " " & _
.Cells(lngZeile, 4) & ", EM" & vbLf
Case "TSG"
strNamen = strNamen & .Cells(lngZeile, 19).Text & _
vbTab & .Cells(lngZeile, 3) & " " & _
.Cells(lngZeile, 4) & ", TSG" & vbLf
Case Else
strNamen = strNamen & .Cells(lngZeile, 19).Text & _
vbTab & .Cells(lngZeile, 3) & " " & _
.Cells(lngZeile, 4) & ", FR" & vbLf
End Select
End If
End If
End If
' Zeilenvariable um 1 erhöhen
lngZeile = lngZeile + 1
Loop
End With
If strNamen "" Then
' es wurden Übereinstimmungen gefunden
MsgBox strNamen, vbInformation, "Heute haben Geburtstag:"
Else
' es wurden keine Übereinstimmungen gefunden
MsgBox "", vbExclamation, "Heute liegt kein Geburtstag an!"
End If
End Sub