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
McCorn:
How to find/configure the XLStart directory?
19 November 2006, 2:52 amross:
Well you've put it all together very well Dick. And, emm, nice colors too
19 November 2006, 9:34 amChristophe:
Looks great! Is it possible to provide your XLS file for download ?
20 November 2006, 1:50 amThanks
chip:
Very nice, Dick, thanks. I improved the aesthetics a bit (to my mind, anyway) by using the same dark photo (of a Delta rocket launch from Cape Canaveral) that I'd been using as a desktop pic. I inserted it into Excel as a background and adjusted my columns to fit the picture size. I reversed all the type out in white vs. the stripey look. I don't have the calendar currently, though I'll probably add that later.
Now I just have to clean up my cluttered desktop so that I can see the numberws without moving files every time!
12 December 2006, 4:47 pmDick Kusleika:
That sounds cool, chip. Send me a screen shot if you get the chance. Thanks.
12 December 2006, 5:40 pmchip:
Dick, I sent one last night to the email I found on the About page (dicks-clicks.com domain). If there's a different one, let me know.
13 December 2006, 11:23 amDick Kusleika:
26 March 2007, 11:12 amCor:
Dick,
I changed the path for where the "mywallpaper.bmp" should be saved. When I open the file it runs through the procedures but the bmp is not saved in the path, in fact, its not saved at all.
Do you have any idea why this happens?
Regards, Cor
21 April 2008, 5:31 am