Desktop Calendar

Here’s what my (partially obfuscated) desktop looks like:

my desktop

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

Private Sub Workbook_Open()
 
    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:

Declare Function SystemParametersInfo Lib “user32” _
   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 SettingsDick.NEBRASKAMy DocumentsMyWallpaper.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:

conditional formatting dialog

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

Posted in Uncategorized

8 thoughts on “Desktop Calendar

  1. 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!

  2. 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.

  3. 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


Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published. Required fields are marked *