Úloha

Ak chcete zistiť všetky piatky 13-ho v intervale dvoch dátumov, zadajte počiatočný dátum do bunky A1 a koncový dátum do bunky A2 v tvare podľa obr. 1.

Pretože budeme potrebovať ovládacie prvky, tieto (obr.2) si vložíme na lištu nástrojov kliknutím na menu nástroje-prispôsobiť-panely nástrojov - ovládacie prvky. Vložte si ovládací prvok s názvom tlačidlo s príkazom (command button - piata ikona zľava na obr. 2) a to dva krát - podľa obr. 3. Potom v režime návrhu - klik na ikonu pravým tlačidlom myši vyberte vlastnosti (obr.4). Zapíšte názvy oboch tlačidiel u položky caption . V režime návrhu dvojklik na tlačidlo označené Vymažte stĺpec B. Zobrazí sa makro:

Private Sub CommandButton1_Click()
End Sub

Medzi hore uvedené dva riadky vložte tento kód:

ActiveWorkbook.Names.Add Name:="stlb", RefersToR1C1:="=Piat13!R1C2:R600C2"
Application.Goto Reference:="stlB"
    Selection.Clear

Teda celé makro bude:

Private Sub CommandButton1_Click()
ActiveWorkbook.Names.Add Name:="stlb", RefersToR1C1:="=Piat13!R1C2:R600C2"
Application.Goto Reference:="stlB"
    Selection.Clear
End Sub

Druhé makro bude:

Private Sub CommandButton2_Click()
Call Ptrinast ' Volá makro nazvané Ptrinst
End Sub

A hlavné (volané) makro:

Public Sub Ptrinast()
Dim i As Integer, j As Integer, rok As Integer
Dim dt1 As String, dt2 As String, iz As Integer, ik As Integer
Dim u As Integer, v As Integer, z As Integer, r As Integer
r = 0
dt1 = Worksheets("Piat13").Cells(1, 1).Value
dt2 = Worksheets("Piat13").Cells(2, 1).Value
iz = Year(dt1)
ik = Year(dt2)
j = Month(dt1)
jj = Month(dt2)
i = Day(dt1)
ii = Day(dt2)
For z = iz To ik
For u = j To jj
For v = i To ii
datm = DateSerial(z, u, v)
If DatePart("d", datm) = 13 Then
pia = datm
If (Weekday(datm) = vbFriday) Then
r = r + 1
' Debug.Print Format(datm, "dddd dd.mm.yyyy")
Worksheets("Piat13").Cells(r, 2).Value = Format(datm, "dddd dd.mm.yyyy")
Worksheets("Piat13").Cells(r, 2).Select
 Selection.Font.ColorIndex = 0
 Selection.Font.Name = "Arial"
 Selection.Font.Size = 10
End If
End If
Next v
Next u
Next z
'Debug.Print r
Columns("B").EntireColumn.AutoFit
With Worksheets("Piat13").Range(Cells(1, 2), Cells(r, 2))
.Interior.Color = RGB(0, 191, 255)
End With
Cells(1, 2).Select
End Sub

Do editora makier sa dostanete stlačením kláves ALT + F11.  Klik v hlavnej ponuke na insert. Vyberte modul a vložte makro Sub Ptrinast().
Poznámka: úpravou makra Ptrinast samozrejme môžete vylistovať ľubovolné dátumy, nielen piatok trinásteho.

Kontakty

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





Domov

©  Klára Mrázová