Daily Dose of Excel

Archive for the ‘Windows API’ Category.

Copy Paste to External Application

5th April 2008, 03:12 pm by Rob van Gelder

Sometimes I find myself copy-pasting between Excel and another application.
In this example, I have a table of three columns: First Name, Last Name, Birth Date.
My external application has 3 text boxes, one for each of those values.

I can't just copy the 3 cells from Excel and paste them to my App, because they would all end up in the first text box!
But, by running VBA SendKeys with a specially crafted string, I can send keystrokes for tabbing to the 2nd and 3rd text boxes.

I also need to activate the SendKeys procedure only when my cursor is positioned correctly, or things could get messy.

My approach is to run a macro that sits there listening for F6 before activating SendKeys.
I've also included listening for the Esc key, just in case I change my mind.

Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

' Virtual-Key Codes http://msdn2.microsoft.com/en-us/library/ms645540(VS.85).aspx
Const VK_F6 = &H75
Const VK_ESC = &H1B

Sub Scanning()
Dim lngRow As Long, str As String

lngRow = Selection.row
str = Cells(lngRow, 1) & vbTab & Cells(lngRow, 2) & vbTab & _
Format(Cells(lngRow, 3), "dd-mmm-yyyy")

MsgBox "Click OK, then click the First Name box on the external application, then press F6 on the keyboard"
WaitAndSend str, VK_F6, VK_ESC
End Sub

Sub WaitAndSend(SendString As String, ExecuteKey As Long, CancelKey As Long)
Do
DoEvents
If GetAsyncKeyState(CancelKey) <> 0 Then Exit Do
If GetAsyncKeyState(ExecuteKey) <> 0 Then
SendKeys SendString, True
Exit Do
End If
Loop
End Sub

Category: Automation, Windows API | 15 Comments

More Dueling Banjos

31st May 2007, 12:39 pm by Dick Kusleika

I tried to use EnableCancelKey to allow myself to stop the music and still make the appropriate API calls to reset the midi out. It didn't work so well for me. Here's another way.

I created two global variables. One to determine whether the procedure was already running and one to determine if the user wants to stop the procedure.

Public gbUserCancel As Boolean
Public gbAppStarted As Boolean

These are declared in a standard module outside of any procedures so that they're accessible from anywhere in the project.

Next, I modified the click event of the button that's used to start the procedure.

Private Sub CommandButton1_Click()

If gbAppStarted Then
gbUserCancel = True
gbAppStarted = False
Else
gbAppStarted = True
PlayWorksheetNotes
End If

End Sub

If the procedure is running (gbApppStarted is True), then it assumed the user wants to stop the procedure and gbUserCancel is set to True. If the procedure is not running, it's called so that it starts running. Finally, I modified the PlayWorksheetNotes procedure to check the gbUserCancel variable.

Sub PlayWorksheetNotes()
Dim r As Long

On Error GoTo ErrHandler

gbUserCancel = False

For r = 2 To Application.CountA(Range("A:A"))
If gbUserCancel Then Err.Raise 9999
Cells(r, 2).Select
Call PlayMIDI(Cells(r, 1), Cells(r, 2), Cells(r, 3))
DoEvents
Next r

ProcExit:
On Error Resume Next
midiOutReset hMidiOut
'Stop
Exit Sub

ErrHandler:
If Err.Number <> 9999 Then
MsgBox Err.Description
End If
'Stop
Resume ProcExit

End Sub

If the button is clicked while the notes are playing, gbUserCancel is set to True. Inside the loop, that variable is check. Once True, an error is raised and the error handler is called. Any error that's not the one I made up (9999) is shown in a message box. Then the procedure resumes at ProcExit which resets the midi out for the future.

Category: Windows API, Visual Basic Editor, Application Object | 1 Comment

EnableCancelKey

22nd May 2007, 04:47 pm by Dick Kusleika

The EnableCancelKey property of the Application object determines what will happen when a user interrupts your code. Users can interrupt code by pressing Esc or Cntl+Break. EnableCancelKey has three possible settings:

xlDisable - Prevents the user from interrupting. I've never used this and can't think of why I ever would.
xlInterrupt - Normal operation. The debugger is shown and the code is in debug mode at whichever line it happened to be when it was interrupted.
xlErrorHandler - Raises error number 18 and reacts just like any other error. If you have error handling set up, it's called.

J-Walk posted about Musical Excel a while back. There was an issue with the midi out API not resetting properly and people could not run the code twice. Mpemba fixed it in the comments with a reset API call, but if the user was to interrupt the code, that API function would never get called.

I downloaded the dueling banjos file from J-Walk, and modified the code. This part was added:

Private Declare Function midiOutReset Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long

and this part was modified:

Sub PlayWorksheetNotes()
Dim r As Long

On Error GoTo ErrHandler

Application.EnableCancelKey = xlErrorHandler

For r = 2 To Application.CountA(Range("A:A"))
Cells(r, 2).Select
Call PlayMIDI(Cells(r, 1), Cells(r, 2), Cells(r, 3))
DoEvents
Next r

ProcExit:
On Error Resume Next
midiOutReset hMidiOut
Stop
Exit Sub

ErrHandler:
If Err.Number <> 18 Then
MsgBox Err.Description
Else
Debug.Print Err.Description
End If
Stop
Resume ProcExit

End Sub

Setting EnableCancelKey allows the code to exit gracefully and ensures that the midiOutReset call is always made. This resets the midi out and should prevent the problem of not being able to run the code twice. It shouldn't really matter whether you have an On Error statement before or after the EnableCancelKey statement.

Actually, this code would exit gracefully except that I have all those 'Stop' commands in there. Oddly, when I set EnableCancelKey to xlInterrupt, it works every time I press Cntl+Break (that is, the code stops and the debugger opens). When I set EnableCancelKey to xlErrorHandler, pressing Cntl+Break works about one out of every thousand times. That estimate is based on me pressing it about 100 times during code execution and the code executes all the way through nine out of ten times.

If you have the time, download dueling-banjos.xls, modified the code as I have and see if you can interrupt normally.

Category: Windows API, Visual Basic Editor, Application Object | 3 Comments

Musical Excel

6th February 2007, 11:18 am by John Walkenbach

I found some code that uses API functions to play MIDI music at a French site. I adapted the code so it's easy to use. Copy the code below and paste it into a VBA module.

Option Explicit
Private Declare Function midiOutOpen Lib "winmm.dll" _
(lphMidiOut As Long, _
ByVal uDeviceID As Long, _
ByVal dwCallback As Long, _
ByVal dwInstance As Long, _
ByVal dwFlags As Long) As Long

Private Declare Function midiOutClose Lib "winmm.dll" _
(ByVal hMidiOut As Long) As Long

Private Declare Function midiOutShortMsg Lib "winmm.dll" _
(ByVal hMidiOut As Long, _
ByVal dwMsg As Long) As Long

Private Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)
Dim hMidiOut As Long
Public lanote As Long

Sub PlayMIDI(voiceNum, noteNum, Duration)
Dim Note As Long
On Error Resume Next
midiOutClose hMidiOut
midiOutOpen hMidiOut, 0, 0, 0, 0
midiOutShortMsg hMidiOut, RGB(192, voiceNum - 1, 127)
lanote = 12 + CLng(noteNum)
Note = RGB(144, lanote, 127)
midiOutShortMsg hMidiOut, Note
Sleep (Duration)
midiOutClose hMidiOut
End Sub

The PlayMIDI Sub procedure accepts three arguments, and plays a single note. The argument are:

voiceNum: A number from 1-128 that represents the instrument sound. Here's a list of the MIDI voice numbers.
noteNum: A number that indicates the note to play. For reference, C is 0, 12, 24, 36, etc. C# is 1, 13, 25, 37, etc.
Duration: A number that indicates how long to play the note, in milliseconds (1,000 equals 1 second).

To play around with this, I set up a worksheet that has a 4-column list of notes. A lookup table provides the actual note letters for the values in column B. In the figure, I have it set up to generate random notes and durations. Then, a simple macro plays the song.

Then, a simple macro plays the song represented by the worksheet data.

Sub TestMidi()
Dim r As Long
ActiveSheet.Calculate
For r = 2 To Application.CountA(Range("A:A"))
Call PlayMIDI(Cells(r, 1), Cells(r, 2), Cells(r, 3))
Next r
End Sub

By the way, I have no idea how this code works. Using the RGB function is a mystery to me. One final note. Avoid stopping the code by pressing Ctrl+Break. If you do that, you may get a stuck note that requires closing Excel.

Category: General, Windows API | 32 Comments

Desktop Calendar

18th November 2006, 10:17 am by Dick Kusleika

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 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:

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

Category: Links, Formatting, Windows API, Formatting Cells, Date Functions, Array formulas | 8 Comments

Registering a User Defined Function with Excel

17th February 2006, 01:22 am by jkpieterse

When one writes a User Defined Function in Excel VBA, this function appears in the function wizard under the category "Custom". It is possible to set which category the function belongs to by changing the "macro properties" of the UDF.

Unfortunately, VBA does not allow specifying a description for the UDF's arguments. There is a workaround which uses the old XLM REGISTER function in conjunction with the ExecuteExcel4Macro function from within VBA (as described in the excellent book Professional Excel Development). This function however only accepts 255 characters or less, which is insufficient for UDF's with more than just one or two arguments and severely limits the amount of text one can use for the explanation of the arguments.

This article describes how this can be overcome, using an ancient XLM macro sheet together with some trickery invented by Laurent Longre.

It enables you to set your own category:

Custom category created by technique described in the article