Desktop Calendar
Here's what my (partially obfuscated) desktop looks like:
I put information I need on my desktop so I'm a Windows+M key combination away from what I need. The Excel file sits in my XLStart directory so the calendar gets updated every day.
VBA from Excel to Desktop
In the Workbook_Open event, I have
If Sheet8.Range("LastUpdate") <> Date Then
Sheet8.Range("LastUpdate") = Date
PrintDesktop
Application.CalculateFull
Me.Save
End If
Me.Close False
End Sub
It only updates it once per day, although it doesn't really take that long to execute. In a standard module, I have:
Alias "SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, ByVal lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Public Const SPI_SETDESKWALLPAPER = 20
Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1
Public Sub SetWallpaper(ByVal FileName As String)
Dim x As Long
x = SystemParametersInfo(SPI_SETDESKWALLPAPER, _
0&, FileName, SPIF_SENDWININICHANGE Or SPIF_UPDATEINIFILE)
End Sub
Sub PrintDesktop()
Dim rng As Range
Dim Fname As String
Dim oPic As IPictureDisp
Set rng = Sheet8.Range("Print_Area")
rng.CopyPicture xlScreen, xlBitmap
Set oPic = PastePicture(xlBitmap)
Fname = "C:\Documents and Settings\Dick.NEBRASKA\My Documents\MyWallpaper.bmp"
SavePicture oPic, Fname
SetWallpaper Fname
End Sub
The PastePicture call uses code from Stephen Bullen's PastePicture.zip file.
Almost nothing in the file is my own - all stolen. In addition to Stephen's PastePicture, the following code is borrowed:
The Calendar
The calendar for this month and next month is John Walkenbach's Array Calendar (see also). For 'next month' I merely added 1 to the month in the DATE function throughout that formula.
Week Numbers
The week numbers along the right come from Ron de Bruin's site. The formula in H27 is
=IF(LEN(B27)=0,"",INT((B27-DATE(YEAR(B27-WEEKDAY(B27-1)+4),1,3)+WEEKDAY(DATE(YEAR(B27-WEEKDAY(B27-1)+4),1,3))+5)/7))
It only shows the week number for weeks with a Monday (B27 in this case).
Highlighting Today and Holidays
The conditional formatting for the current month looks like this:
The first format inverts the colors for the current day. The second format checks the range HolVac to see if the date is a holiday - meaning a day I don't work. In that range, I have the holidays my company offers plus I enter any scheduled vacation days. I show the holiday formulas below. The second format is repeated for 'next month'.
Special Characters
Because I deal with German companies on a somewhat regular basis, I like to keep the ASCII codes for some German characters handy, and I do that across the bottom. To enter the special characters, hold down the Alt key and type the four digit number on the numeric keypad.
Holiday Formulas
The formulas for the holidays come from Chip Pearson's Holiday Page and Chip's Date and Time Page. In the following formulas, cell S1 contains the current year and S2 contains the next year.
New Year's Day: =IF(WEEKDAY(DATE(S1,1,1))=7,DATE(S1,1,1)-1,IF(WEEKDAY(DATE(S1,1,1))=1,DATE(S1,1,1)+1,DATE(S1,1,1)))
Next New Year's Day: =IF(WEEKDAY(DATE(S2,1,1))=7,DATE(S2,1,1)-1,IF(WEEKDAY(DATE(S2,1,1))=1,DATE(S2,1,1)+1,DATE(S2,1,1)))
Memorial Day: (array) =IF(SUM(IF(WEEKDAY(DATE($S$1,5,1)-1+ROW(INDIRECT("1:"&TRUNC(DATE($S$1,5,31)-DATE($S$1,5,1))+1)))=2,1,0))=5,
DATE(YEAR(NOW()),5,1+((5-(2>=WEEKDAY(DATE(YEAR(NOW()),5,1))))*7)+(2-WEEKDAY(DATE(YEAR(NOW()),5,1)))),
DATE(YEAR(NOW()),5,1+((4-(2>=WEEKDAY(DATE(YEAR(NOW()),5,1))))*7)+(2-WEEKDAY(DATE(YEAR(NOW()),5,1)))))
US Indpendence Day: =IF(WEEKDAY(DATE(S1,7,4))=7,DATE(S1,7,4)-1,IF(WEEKDAY(DATE(S1,7,4))=1,DATE(S1,7,4)+1,DATE(S1,7,4)))
Labor Day: =DATE(S1,9,1+((1-(2>=WEEKDAY(DATE(S1,9,1))))*7)+(2-WEEKDAY(DATE(S1,9,1))))
Thanksgiving: =DATE(S1,11,1+((4-(5>=WEEKDAY(DATE(S1,11,1))))*7)+(5-WEEKDAY(DATE(S1,11,1))))
Xmas Eve: =IF(WEEKDAY(DATE(S1,12,24))=7,DATE(S1,12,24)-1,IF(WEEKDAY(DATE(S1,12,24))=1,DATE(S1,12,24)-2,DATE(S1,12,24)))
Xmas: =IF(WEEKDAY(DATE(S1,12,25))=7,DATE(S1,12,25)-1,IF(WEEKDAY(DATE(S1,12,25))=1,DATE(S1,12,25)+1,DATE(S1,12,25)))
Update: Download DesktopPic.zip
