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.
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.
Marta Hlušíková: AB URBE CONDITA, Slovník latinských citátov. © Vydavateľstvo KNIHA-SPOLOČNÍK, 2000.
CesSloKal.zip Veľkosť: 17kB,