Function Kalendar()
Dim WKS As Worksheet
Dim StrMjesec As String
Dim Mjesec As Integer
Dim Adresa(1 To 2) As String
Dim Polje As Range
Dim Red(1 To 2) As Integer
Dim Kolona(1 To 2) As Integer
Dim K(1 To 2) As Integer
Dim Celija As Range
Dim Dan As Integer
Dim Datum As Date
Dim Ime As String
Set WKS = Worksheets.Add
Ime = "Kalendar" & Mid(WKS.Name, 6)
WKS.Name = Ime
ActiveWindow.DisplayGridlines = False
With Cells
.ColumnWidth = 6#
.Font.Size = 8
End With
K(2) = 1
For Mjesec = 1 To 12
StrMjesec = Choose(Mjesec, "Januar", "Februar", "Mart", "April", "Maj", "Juni", "Juli", _
"August", "Septembar", "Oktobar", "Novembar", "Decembar")
K(1) = Mjesec Mod 3
If K(1) = 0 Then K(1) = 3
Kolona(2) = K(1) * 7
Kolona(1) = Kolona(2) - 6
Red(2) = K(2) * 8
Red(1) = Red(2) - 7
Set Polje = WKS.Cells(Red(1), Kolona(1))
Adresa(1) = Polje.Address
Set Polje = WKS.Cells(Red(1), Kolona(2))
Adresa(2) = Polje.Address
Set Polje = Range(Adresa(1), Adresa(2))
Polje.Merge
Polje.Value = StrMjesec
Polje.HorizontalAlignment = xlCenter
Polje.Interior.ColorIndex = 6
Polje.Font.Bold = True
Pol****rderAround LineStyle:=xlContinuous
Red(1) = Red(1) + 1
Set Polje = WKS.Cells(Red(1), Kolona(1))
Adresa(1) = Polje.Address
Set Polje = WKS.Cells(Red(1), Kolona(2))
Adresa(2) = Polje.Address
Range(Adresa(1), Adresa(2)).BorderAround LineStyle:=xlContinuous
Range(Adresa(1), Adresa(2)).Interior.ColorIndex = 1
Range(Adresa(1), Adresa(2)).Font.ColorIndex = 2
Dan = 0
For Each Celija In Range(Adresa(1), Adresa(2))
Dan = Dan + 1
Datum = DateSerial(Year(Date), Mjesec, Dan)
With Celija
.Value = Datum
.NumberFormat = "ddd"
End With
Next Celija
Red(1) = Red(1) + 1
Set Polje = WKS.Cells(Red(1), Kolona(1))
Adresa(1) = Polje.Address
Set Polje = WKS.Cells(Red(2), Kolona(2))
Adresa(2) = Polje.Address
Dan = 0
Range(Adresa(1), Adresa(2)).BorderAround LineStyle:=xlContinuous
Range(Adresa(1), Adresa(2)).Interior.ColorIndex = 15
For Each Celija In Range(Adresa(1), Adresa(2))
Dan = Dan + 1
Datum = DateSerial(Year(Date), Mjesec, Dan)
If Month(Datum) = Mjesec Then
With Celija
.Value = Datum
.NumberFormat = "dd"
If Datum = Date Then
Celija.BorderAround LineStyle:=xlContinuous
'Celija.Interior.ColorIndex = 9
Celija.Select
End If
End With
End If
Next Celija
If K(1) = 3 Then
K(2) = K(2) + 1
End If
Next Mjesec
End Function