"Večný kalendár"

V tomto článku ukážeme, ako využiť vzorec pre určenie dátumu Veľkej noci ako aj vzorca pre automatické určenie, či je rok prestupný. Tieto vzorce boli uvedené v predchádzajúcom článku Kalendáre.
Ak si chcete zostrojiť kalendár, ktorý bude platný pre roky 2004 až 2099 vložte si: Príprava formulára

Na formulár umiestnite: Label 2 má meno Koniec a do Label 6 môžete vložiť svoje meno.Použitie ostatných menoviek je jasné z nasledujúceho obrázka:

Formulár


Option Base 1 ' Polia začínajú indexom 1
Dim rok As Integer
Private Sub UserForm_Initialize()
  Dim meno(366, 4) As String, cmen(366, 4) As String
  Dim cis As Integer, i As Integer, k As Integer, u As Integer
  Dim z As Integer, m As Integer, cas As Variant
  Dim vn As String, vn1 As String, cit(31) As String
  ChDir "C:\Winkal\"
  rok = Year(Date)
  mcas = Format(Time, "hh:mm:ss")
  If Prest(rok) = 2 Then GoTo nav1 ' neprestupný
  'voláme funkciu Prest - či je rok prestupný
  Open "SkalPr.txt" For Input As #1
  ' slovenský pre prestupné roky
  Open "CkalPr.txt" For Input As #2
  'český pre prestupné roky
  mcas = Format(Time, "Long Time")
  For u = 1 To 366
    For z = 1 To 4
      Input #1, meno(u, z)
      'Prečíta 1 riadok, dátum, meno, meno, sviatok
    Next z
  Next u
  Close #1
  For u = 1 To 366
    For z = 1 To 4
      Input #2, cmen(u, z)
      'Prečíta 1 riadok, dátum, meno, meno, sviatok
    Next z
  Next u
  Close #2
  GoTo nav2
nav1:
  Open "Skal.txt" For Input As #1
  'neprestupné roky-slov.
  Open "Ckal.txt" For Input As #2
  'neprestupné roky-čes.
  For u = 1 To 365
    For z = 1 To 4
      Input #1, meno(u, z)
      'Prečíta 1 riadok, dátum, meno, meno, sviatok
    Next z
  Next u
  Close #1
  For u = 1 To 365
    For z = 1 To 4
      Input #2, cmen(u, z)
      'Prečíta 1 riadok, dátum, meno, meno, sviatok
    Next z
  Next u
  Close #2
nav2:
k = Day(Date) ' deň v mesiaci
  Open "LatCit.txt" For Input As #2
  For m = 1 To 31
    Line Input #2, cit(m)
    'prečíta na každý deň mesiaca
    'jeden latinský citát
  Next m
  Close #2
  Call VelkaNoc(rok)
  If (Date = VelkaNoc(rok)) Then vn = " a je Veľkonočná nedeľa"
  If (Date = VelkaNoc(rok)) Then vn1 = " a je Velikonoční neděle"
  kk = Format(Date, "dddd dd.mm.yyyy")
  UserForm1.Label1.Caption = "Dnes je " & kk
  UserForm1.Label7.Caption = mcas
  slovo = " "
  dtt = Date - DateSerial(rok, 1, 1) + 1 ' deň roka
  UserForm1.Label5.Caption = cit(k)
  If (Date = VelkaNoc(rok)) Then meno(dtt, 4) = vn
  If meno(dtt, 3) <> "" Then slovo = " a "
  If (meno(dtt, 2) <> "") Then
    UserForm1.Label3.Caption = "Meniny má  " _
    & meno(dtt, 2) & slovo & meno(dtt, 3)
    ElseIf (meno(dtt, 2) = "") Then
    UserForm1.Label3.Caption = meno(dtt, 4)
  End If
  If (meno(dtt, 4) <> "" And meno(dtt, 2) <> "" _
  Or meno(dtt, 3) <> "") Then
    UserForm1.Label3.Caption = "Meniny má  " _
    & meno(dtt, 2) & slovo _
    & meno(dtt, 3) & meno(dtt, 4)
  End If
  slovo = " "
  If (Date = VelkaNoc(rok)) Then cmen(dtt, 4) = vn1
  If cmen(dtt, 3) <> "" Then slovo = " a "
  If (cmen(dtt, 2) <> "") Then
    UserForm1.Label4.Caption = "Jmeniny má  " _
    & cmen(dtt, 2) & slovo & cmen(dtt, 3)
    ElseIf (cmen(dtt, 2) = "") Then
    UserForm1.Label4.Caption = cmen(dtt, 4)
  End If
  If (cmen(dtt, 4) <> "" And cmen(dtt, 2) <> "" _
  Or cmen(dtt, 3) <> "") Then
    UserForm1.Label4.Caption = "Jmeniny má  " _
    & cmen(dtt, 2) & slovo & _
    cmen(dtt, 3) & cmen(dtt, 4)
  End If
  If (Month(Date) = 1 And Day(Date) >= 21 _
    Or (Month(Date) = 2 And Day(Date) <= 19)) Then
    Image1.Picture = LoadPicture("c:\Winkal\vodnár.bmp")
  End If
  If (Month(Date) = 2 And Day(Date) >= 20 _
    Or (Month(Date) = 3 And Day(Date) <= 20)) Then
    Image1.Picture = LoadPicture("c:\Winkal\ryby.bmp")
  End If
  If (Month(Date) = 3 And Day(Date) >= 21 _
    Or (Month(Date) = 4 And Day(Date) <= 20)) Then
    Image1.Picture = LoadPicture("c:\Winkal\baran.bmp")
  End If
  If (Month(Date) = 4 And Day(Date) >= 21 _
    Or (Month(Date) = 5 And Day(Date) <= 21)) Then
    Image1.Picture = LoadPicture("c:\Winkal\býk.bmp")
  End If
  If (Month(Date) = 5 And Day(Date) >= 2 _
    Or (Month(Date) = 6 And Day(Date) <= 21)) Then
    Image1.Picture = LoadPicture("c:\Winkal\blíženci.bmp")
  End If
  If (Month(Date) = 6 And Day(Date) >= 25 _
    Or (Month(Date) = 7 And Day(Date) <= 22)) Then
    Image1.Picture = LoadPicture("c:\Winkal\rak.bmp")
  End If
  If (Month(Date) = 7 And Day(Date) >= 23 _
    Or (Month(Date) = 8 And Day(Date) <= 23)) Then
    Image1.Picture = LoadPicture("c:\Winkal\lev.bmp")
  End If
  If (Month(Date) = 8 And Day(Date) >= 24 _
    Or (Month(Date) = 9 And Day(Date) <= 23)) Then
    Image1.Picture = LoadPicture("c:\Winkal\panna.bmp")
  End If
  If (Month(Date) = 9 And Day(Date) >= 24 _
    Or (Month(Date) = 10 And Day(Date) <= 23)) Then
    Image1.Picture = LoadPicture("c:\Winkal\váhy.bmp")
  End If
  If (Month(Date) = 10 And Day(Date) >= 24 _
    Or (Month(Date) = 11 And Day(Date) <= 22)) Then
    Image1.Picture = LoadPicture("c:\Winkal\škorpion.bmp")
  End If
  If (Month(Date) = 11 And Day(Date) >= 23 _
    Or (Month(Date) = 12 And Day(Date) <= 21)) Then
    Image1.Picture = LoadPicture("c:\Winkal\strelec.bmp")
  End If
  If (Month(Date) = 12 And Day(Date) >= 22 _
    Or (Month(Date) = 1 And Day(Date) <= 20)) Then
    Image1.Picture = LoadPicture("c:\Winkal\kozorožec.bmp")
  End If
  Intervall = Now + TimeValue("00:00:01")
  Application.OnTime Intervall, "Start"
  'voláme subrutínu Start
  UserForm1.Show
End Sub

Public Function VelkaNoc(rok As Integer) As Date
  Dim d As Integer
  d = (((255 - 11 * (rok Mod 19)) - 21) Mod 30) + 21
  VelkaNoc = DateSerial(rok, 3, 1) + d + _
  (d > 48) + 6 - ((rok + rok \ 4 + _
  d + (d > 48) + 1) Mod 7)
End Function
Public Function Prest(rok) As Integer
  If rok Mod 100 = 0 Then 'rr pre storočia
    rr = rok Mod 400
  Else
    rr = rok Mod 4 ' rr pre ostatne roky
  End If
  If rr = 0 Then
    Prest = 1
  Else
    Prest = 2
  End If
End Function
Private Sub Label2_Click()
  Call Stopp
  End
End Sub

Aby v menovke č. 7 sa zobrazoval plynúci čas, vložíme do VBA projektu modul, ktorý môžeme nazvať čas a do tohoto modulu vložíme dva podprogramy Start a Stopp.

VBA project

Public Intervall As Date
Sub Start()
    Intervall = Now + TimeValue("00:00:01")
    t = Format(Time, "hh:mm:ss")
    UserForm1.Label7.Caption = t
    'Application.StatusBar = t
    'odstránením znaku komentára
    'bude aj v stavovom riadku zobrazený čas
    Application.OnTime Intervall, "Start"
End Sub
Sub Stopp()
    On Error Resume Next
    Application.OnTime Intervall, "Start", , False
    Application.StatusBar = False
End Sub

Teraz už len treba zhotoviť textový súbor s latinskými citátmi a 2 súbory - český a slovenský kalendár, pre prestupné roky (doplniť o 29.február) a 2 súbory, tie isté, bez 29. februára. Príklady boli vypracované v Excel 2000 pod OS Windows XP.

Použitá literatúra:

Marta Hlušíková: AB URBE CONDITA, Slovník latinských citátov. © Vydavateľstvo KNIHA-SPOLOČNÍK, 2000.

CesSloKal.zip    Veľkosť: 17kB,

Kal.zip    Veľkosť: 20kB,   obsahuje 2 súbory, slovenský a český kalendár


Domov

Valid HTML 4.01 Transitional

Stránka je v súlade s aktuálnymi normami.



© Klára Mrázová