Evidencia jubileí zamestnancov

Výpočet veku môžeme vykonať dvoma spôsobmi:

• použijeme vzorec s dátovou funkciou today()
• použijeme málo známu funkciu datedif (upozornenie: vo VBA sa táto funkcia píše datediff).

Funkcia DATEDIF(poč. dátum;konc. dátum;jednotka) vypočíta počet dní, mesiacov alebo rokov medzi dvoma dátumami.

Funkcia datedif vo verzii Excel 97 nebola definovaná . V Exceli 2000 je definovaná, ale nenachádza sa v kategóriach funkcii, ktoré môžete prilepiť (Kto vie prečo?). Ak ju chcete použiť, treba ju do bunky natypovať. Ak použijeme vzorec 1. výsledok bude v rokoch, vzorec 2. udáva výsledok v rokoch a mesiacoch a napokon vzorec 3. poskytne úplne presný výsledok v rokoch, mesiacoch a dňoch

1. =DATEDIF(B3;TODAY();"y")
2. =DATEDIF(B3;TODAY();"y")& " r. "&DATEDIF(B3;TODAY();"ym")&" m."
3. =DATEDIF(B3;TODAY();"y")&" r. "&DATEDIF(B3;TODAY();"ym")&" m. "&DATEDIF(B3;TODAY();"md")&" d."

Druhá možnosť - asi jednoduchšia je použitie vzorca (podľa obrázka 2.): =(today()-B3)/365,25 V odkazoch na bunky dávame v oboch vzorcoh relatívne adresy, aby sme mohli potiahnúť za úchytku bunky a Excel dosadí aj v ostatných bunkách adekvátne vzorce. Stĺpec, v ktorom je vek, vypočítaný podľa vzorca s funkciou today() naformátujeme ako celé číslo - roky sú zaokrúhlené smerom hore.

Ak potrebujete upozornenie na narodeniny (napr. x dní dopredu, môžeme použiť nasledujúcu procedúru VBA:

Public Sub Jubil()
Dim pocR As Integer, pocS As Integer, obl1 As Range
Dim j As Integer, k As Integer, h(1000) As Integer, g(1000) As Integer
Dim dtm As Date, dtnr As String
Dim bunka As Object, kontr As Boolean
Worksheets(1).Activate
Range("A1").Select
Set obl1 = ActiveCell.CurrentRegion
obl1.Select
pocR = Selection.Rows.Count
pocS = Selection.Columns.Count
obl1.Offset(2, 0).Resize(obl1.Rows.Count - 2, obl1.Columns.Count).Select
pocR = Selection.Rows.Count
pocS = Selection.Columns.Count
j = Selection.Rows.Row ' zistí číslo prvého riadku vo zvolenej oblasti
k = Selection.Columns.Column ' číslo prvého stapca vo zvolenej oblasti
prr = j + pocR - 1 'posledný riadok zvolenej oblasti
For m = j To prr
        Cells(m, 3).Select
        With Selection.Font
            .Name = "Arial"
            .Size = 8
        End With
        With Selection.Interior
            .ColorIndex = 36
            .Pattern = xlSolid
        End With
        h(m) = Cells(m, 2).Value ' zápis do poľa h - hodnoty v bunkách Cells(m,2)
        'dátum narodenia premenený na počet dní od 1.1.1900 (konvencia)
        g(m) = (Now() - h(m)) / 365.25 'výpočet veku (roky)
        Cells(m, 3).Formula = g(m)
        dtm = Cells(m, 2).Value
        rk = Year(Date)
        ms = Month(dtm)
        dn = Day(dtm)
        mn = Month(Date)
        di = ms - mn
        If (di < 0) Then rk = rk + 1
        dtnr = dn & "." & ms & "." & rk
        Cells(m, 4) = dtnr
        dni = CDate(dtnr) - CDate(Date)
        dnii = Format(dni, "# ##0")
        Cells(m, 5) = dnii
Next m
obl1.Offset(2, 2).Resize(obl1.Rows.Count - 2, obl1.Columns.Count - 2).Select
pocR = Selection.Rows.Count
pocS = Selection.Columns.Count
'Debug.Print pocR; pocS
    With Selection
        .HorizontalAlignment = xlRight
    End With
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Tučné"
        .Size = 8
        .ColorIndex = 9
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThick
        .ColorIndex = 5
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 5
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 5
    End With
    Selection.Interior.ColorIndex = 36
For n = 3 To 6
    If (Cells(n, 5) >= 0# And Cells(n, 5) <= 5) Then
        Cells(n, 5).Interior.Color = RGB(255, 0, 0) ' červená
    blk (n)
    End If
Next n
Cells(1, 1).Select
End Sub

Function blk(n)
Dim plus, start
plus = 1
zac = Time
kon = Time + TimeValue("00:00:3")
nav1:
start = Timer    ' Nastav začiatok
  Do While Timer < start + plus
    Cells(n, 5).Interior.Color = RGB(255, 255, 255) ' bielá   ' kým uplynie 1 sekunda bliká
  Loop
start = Timer
  Do While Timer < start + plus
   Cells(n, 5).Interior.Color = RGB(255, 0, 0) ' červená     ' kým uplynie 1 seunda bliká
  Loop
If ((Time < kon)) Then
   GoTo nav1:
End If
End Function

Ak si zostavíte tabuľku ako je napr. na obr. 3, t.j. bude mať 5 stĺpcov a ľubovolný počet riadkov, ale v 1 riadku budú bunky zlúčené a bude tam nadpis tabuľky, v druhom riadku menovky stĺpcov, v stĺpci 1 budú mená (píšte mená najprv priezvisko a potom krstné meno, kvôli triedeniu), v druhom stĺpci budú dátumy narodenia (obr. 3) potom môžete použiť procedúru Jubil v ktorej je volaná funkcia blk(n). Program vyplní stĺpce 3,4 a 5 a funkcia blk(n) zvýrazní bunky s počtom dní od aktuálneho dátumu, ak počet dní je <= 5 (samozrejme koľko dní to má byť, môžete zmeniť v procedúre. Po spustení programu Jubil, v 5 stĺpci, v riadkoch kde počet dní bude <= 5 bliknú farby červená a biela.
(Poznámka: príklad bol robený 3.11.2007, teda today() bol 3.11.2007)

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