Kalender für 10.000 Jahre programmieren mit VisualBasic Excel, Access VBA

Kalender für 10.000 Jahre programmieren mit VisualBasic Excel, Access VBA

Author D.Selzer-McKenzie

Video: http://youtu.be/9JDwqP0Wb1Y

In diesem Video zeige ich Ihnen, wie Sie ganz einfach Jahreskalender für 100000 Jahre erstellen können. Sehen Sie im Film, hier habe ich nur eingegeben die Jahre 2015, 1492,1871,2,792,2587 n.Chr. und für das jeweilige Jahr wird ein konkreter Kalender erstellt. Jeder Tag hat sogar eine eigene Farbe. Möglich sind also alle Kalenderjahre ab 1.nach Christi bis 9.999 nach Christi.

Den SourceCode, der für Visual Basic, Excel, Access VBA und Visual C gleich ist, können Sie kostenlos herunterladen im Forum

http://Outbackbrumby.Blogspot.com

 

Hier der SourceCode:

Option Explicit

 

Sub Jahreskalender()

   Dim ws As Worksheet

   Dim varYear As Variant

   Dim bytMonth As Byte

   Dim bytDay As Byte

   Dim bytWeekday As Byte

   Dim strWeekday As String

   Dim bytWeekNo As Byte

   Dim bytDummy As Byte

  

   ' Das Jahr des Kalenders der ausgegeben werden soll

   varYear = Range("B2")

  

   ' Falls bereits ein Blatt mit dem Namen "Jahr xxxx"

   ' entsteht, soll dieses gelöscht werden

   For Each ws In Worksheets

      If ws.Name = "Jahr " & varYear Then

         ws.Delete

      End If

   Next ws

  

   ' Ein neues Tabellenblatt mit dem Namen "Jahr xxxx"

   ' einfügen

   Worksheets.Add

   ActiveSheet.Name = "Jahr " & varYear

  

   ' Monatsüberschriften einfügen und formatieren

   For bytMonth = 1 To 12

      With Cells(1, bytMonth)

         .Value = Format(DateSerial(varYear, bytMonth, 1), _

                         "mmmm")

         .Interior.ColorIndex = 36

         .Font.Bold = True

      End With

     

      ' Tage aufbereiten

      For bytDay = 1 To Day(DateSerial _

                           (varYear, bytMonth + 1, 0))

         With Cells(bytDay + 1, bytMonth)

           bytWeekday = Weekday(DateSerial _

                               (varYear, bytMonth, bytDay))

          

           ' Wochentage in Textformat aufbereiten

           Select Case bytWeekday

              Case 1

                 strWeekday = "Sonntag"

              Case 2

                 strWeekday = "Montag"

              Case 3

                 strWeekday = "Dienstag"

              Case 4

                 strWeekday = "Mittwoch"

              Case 5

                 strWeekday = "Donnerstag"

              Case 6

                 strWeekday = "Freitag"

              Case 7

                 strWeekday = "Samstag"

           End Select

          

           ' Wochentage und Tage eintragen

           .Value = bytDay & " " & strWeekday & ", "

 

           ' Sontag mit entsprechender Farbe hervorheben

           If bytWeekday = 1 Then

              .Interior.ColorIndex = 45

           End If

          

             ' Montag mit entsprechender Farbe hervorheben

           If bytWeekday = 2 Then

              .Interior.ColorIndex = 33

           End If

           

           ' Dienstag mit entsprechender Farbe hervorheben

           If bytWeekday = 3 Then

              .Interior.ColorIndex = 39

           End If

            

           ' Mittwoch mit entsprechender Farbe hervorheben

           If bytWeekday = 4 Then

              .Interior.ColorIndex = 50

           End If

            

            ' Donnerstag mit entsprechender Farbe hervorheben

           If bytWeekday = 5 Then

              .Interior.ColorIndex = 20

           End If

              

            ' Freitag mit entsprechender Farbe hervorheben

           If bytWeekday = 6 Then

              .Interior.ColorIndex = 4

           End If

           

            ' Samstag mit entsprechender Farbe hervorheben

           If bytWeekday = 7 Then

              .Interior.ColorIndex = 15

           End If

              

 

 

           ' Kalenderwoche eintragen

           bytWeekNo = _

              Format(DateSerial(varYear, bytMonth, bytDay), "ww")

           If bytDummy < bytWeekNo And strWeekday = "Mo" Then

              bytDummy = bytWeekNo

              .Value = .Value & " (" & bytDummy & ")"

              ' Formatierung Kalenderwoche

              With .Characters _

                   (Start:=InStr(1, .Value, "("), _

                                 Length:=4).Font

                 .Size = 8

                 .Color = vbRed

              End With

           End If

 

         End With

      Next bytDay

   Next bytMonth

End Sub