View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Gabriele C[_3_] Gabriele C[_3_] is offline
external usenet poster
 
Posts: 1
Default VBA : get a period - fill cells in calendar?

Dear Tom,
your code was too short to be understood by a novice like me...
But with your advices I wrote this code...raw but works fine...
Is there something I should change to avoid errors or to speedup?I kno
just a very little of vba...
Regards



Sub calendario()
Application.ScreenUpdating = False
Worksheets("1").Activate
Worksheets("1").Unprotect Password:="thankyoutom"
Range("E5:AI16").Select
Selection.ClearContents

Worksheets("2").Activate
i = 4
While (Cells(i, 4).Value) < ""
cyear = Year(Cells(i, 4))
startday = Day(Cells(i, 4))
endday = Day(Cells(i, 5))
startmonth = Month(Cells(i, 4))
endmonth = Month(Cells(i, 5))
lstartday = startday + 4
'in sheet2,1st January is in (5,5)'
lstartmonth = startmonth + 4
lendday = endday + 4
lendmonth = endmonth + 4

Worksheets("2").Activate
While lstartmonth < lendmonth

If lstartmonth = 6 Then
If (cyear Mod 4) = 0 Then MLENGHT = 33 Els
lstartmonth = 32

ElseIf lstartmonth = 8 Or lstartmonth = 10 O
lstartmonth = 13 Or lstartmonth = _
15 Then MLENGHT = 34

Else: MLENGHT = 35
End If
Range(Cells(lstartmonth, lstartday)
Cells(lstartmonth, MLENGHT)).Value = "X"
lstartmonth = lstartmonth + 1
lstartday = 5
Wend
Range(Cells(lendmonth, lstartday), Cells(lendmonth
lendday)).Value = "X"
i = i + 1
Worksheets("1").Activate

Wend
Worksheets("2").Activate
ActiveSheet.Protect Password:="thankyoutom", DrawingObjects:=True
Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.ScreenUpdating = True
End Su

--
Message posted from http://www.ExcelForum.com