Ermitteln, wann der 13. eines Monats auf Freitag fällt (VB6) Alle Datumswerte mit Freitag, den 13. ermitteln
Autor:   Zardoz	Bewertung:     [ Jetzt bewerten ]	Views:  5.456
ohne Homepage	System:  WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 5 Bewertung insgesamt: nützlich Durchschnittliche Bewertung: 2.6 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Im  letzten Tipp wurde ein .Net-Code veröffentlicht, mit dem man Datumswerte ermitteln kann, die auf Freitag den 13. fallen. Das geht natürlich auch in VB6. Man braucht übrigens nicht jeden Tag eines Jahres zu testen, sondern nur jeweils den 13. eines Monats. Das reduziert den Rechenaufwand.

Erstellen Sie ein neues Projekt und fügen der Form einen Command-Button (Command1), sowie ein ListBox-Control (List1) hinzu.

Private Sub Command1_Click()
  Dim Jahr As Long
  Dim Monat As Long
  Dim J1 As Long
  Dim J2 As Long
  Dim flg1 As Boolean
  Dim Info As String
  Dim Idx As Long
  Dim Datum As String
 
  J1 = Year(Date)     ' Aktuelles Jahr
  J2 = J1 + 20        ' Aktuelles Jahr + 20
  flg1 = False
 
  With List1
    .Visible = False
    .Clear
 
    ' alle Jahre durchlaufen
    For Jahr = J1 To J2
      ' alle Monate pro Jahr durchlauden
      For Monat = 1 To 12
        ' Prüfen, ob der 13. des Monats ein Freitag ist
        Datum = "13." & Format$(Monat, "00") & "." & CStr(Jahr)
        If Weekday(Datum, vbSunday) = vbFriday Then
 
          Info = ""
          If flg1 = False Then
            If CDate(Datum) >= Date Then
              flg1 = True
              Info = " <- Nächster!"
              Idx = .NewIndex
            End If
          End If
 
          .AddItem FormatDateTime(Datum, vbLongDate) & Info
        End If
      Next Monat
    Next Jahr
 
    .AddItem CStr(.ListCount) & " Einträge von " & _
      CStr(J1) & " bis " & CStr(J2)
    .ListIndex = Idx + 1
    .Visible = True
    .SetFocus
  End With
End Sub