Dutch Gemini's Weblog Pages

April 17, 2012

Excel (VBA) error: Could not load an object because it is not available on this machine

Filed under: Excel,VBA,Windows — dutchgemini @ 10:09 am
Tags: , , , , , , , ,

Update: if you are having problems after installing Security Patch MS12-060 then click here.


Update (Thu Oct 18, 2012): Security Patch MS12-060 also appears to modify the TypeLib information of MSCOMCTL.OCX in the registry. Before the patch, references to MSCOMCTL in the VBA code would resolve to version “2.0” of the library. With MS12-060, this version has been updated to “2.1”. This was discovered using ProcMon on 2 different PC’s, one patch and one unpatched.

The result is that if in your VBA code you make explicit, early bonded, reference to this library or to components in the library such as in “Dim oListItems As MSComctlLib.ListItems“, Excel stores the newer version of MSCOMCTL.OCX in your project. When you transfer the workbook to a PC without the MS12-060 Security Patch (or even without MS12-027) then your project will inevitable fail.

Currently, the only way I found to recover my work (excluding building up the project from scratch inserting one by one all modules) is to add to the registry the node on the MSCOMCTL typeLib for version “2.1” (which is exactly the same as the “2.0” node):

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\TypeLib\{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}\2.1]
@="Microsoft Windows Common Controls 6.0 (SP6)"

[HKEY_CLASSES_ROOT\TypeLib\{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}\2.1]

[HKEY_CLASSES_ROOT\TypeLib\{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}\2.1\win32]
@="C:\\WINDOWS\\system32\\MSCOMCTL.OCX"

[HKEY_CLASSES_ROOT\TypeLib\{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}\2.1\FLAGS]
@="2"

[HKEY_CLASSES_ROOT\TypeLib\{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}\2.1\HELPDIR]
@=""

Remind that this is not a universal solution and it will not allow you to run VBA projects on every PC around, but at least it does allow you to get back to a working system. Hopefully I am able to provide a permanent fix for this issue as well.


Security Patch MS12-027 (Vulnerability in MSCOMCTL.OCX could allow Remote Code Execution) of April 10, 2012 causes a problem that may result in the “Could not load an object because it is not available on this machine” error message when starting Excel with a workbook or an Add-In that uses components from the selected file. Usually a second other error message is also triggered is “Compile error in hidden module: <name of module>“.

To protect your PC, this patch installs an updated version of MSCOMCTL.OCX with the same COM Interface so you can use it without changing one line of code but with a different Class Id (CLSID). Via the Registry all applications seeking the original CLSID are redirected to the new CLSID so that you can continue using it safely. The section of the Registry doing this redirection is “HKLM\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility“.

You may ask yourself: «what does Internet Explorer’s ActiveX Compatibility have to do with Excel?» Well, it does, and it does a lot. Excel scans the same registry section for understanding whether it can safely load a component and what CLSID it should use as an alternative. Try ProcessMonitor and you’ll see.

When you edit an Excel workbook —doesn’t matter the format, XLS/XLA/XLSM/XLAM all have it— on a PC where the patched MSCOMCTL.OCX is installed, then Excel links internally the control to the new CLSID.

In principle the patch integrates flawlessly and you should see no difference when running Excel with a workbook or an Add-In using components from MSCOMCTL.OCX. I heavily rely in my VBA projects on the Microsoft ListView Control 6.0 ActiveX control which is contained in this file and have been able to use it without any trouble.

In the event that opening Excel does trigger the above error message(s), then this link can provide a fix. If you want to read individual info for a specific Office release, click on one of the release numbers: 2003  2007 2010

Office 2000 or 2002 are likely only affected if you have 2003 components installed, for instance when having Outlook 2003 side-by-side with Office 2002.

Wouldn’t it be that if at that point you transfer (or distribute) the Excel workbook or the Excel Add-In to a PC without the Security Patch installed, Excel will look for the new CLSID but cannot find it and that will trigger the above error message. Note that the fix mentioned earlier will not work. As a confirmation of this issue you can open the VBA project, edit a UserForm with such control in design mode and see that the particular control is indeed missing.

My main development environment is based on Windows XP and Excel 2002 and I use various Virtual PC instances running all possible combinations of Windows XP, Vista and 7 with Excel 2000, 2003, 2007 and 2010 32-bit to test the developed applications. Only the main environment is patched with Windows Update but the Virtual PC’s are not.

This week I finished a project and saved the XLS, copied it to the Virtual PC with Excel 2007 and opened it for the transformation in XLSM and to my surprise I got the error. The bad thing is that I can’t open the XLS (nor the XLSM, XLA or XLAM) on any of the mentioned Virtual PC’s because all them give the error.

I even tried to rescue the project starting a blank workbook and importing the UserForms exported from the XLS on the only PC that is working, but nada, niente, nothing, zero success. I deduct from this that in the associated .FRX file there must be a link to the new CLSID but am still unable to find out where. This makes also sense: Excel uses early binding when using ActiveX control at design time, and early binding generally uses CLSID’s and not the component’s class name.

Of course you can redesign the forms by adding the ListView again because on the failing PC there is indeed a valid ListView ActiveX control, but this is quite a PITB and is no guarantee that it will work.

As it looks now, I will need to install the Security Patch everywhere. I am looking if there is a way to bypass this need.

Security Patch MS12-027 cannot be uninstalled, this patch is considered critical and each PC should be updated as soon as possible but this is not always the case.

Update (and temporary solution)

I have found a trick —a Registry hack to be honest— that helps me open and use the failing workbook on un-patched PC’s. This hack consists in telling Excel to use the old interface instead of the new interface.

Note: Excel workbooks or Excel Add-Ins which are edited/saved on a PC with the Registry hack will open/work on both the patched and un-patched PC’s, thus including PC’s having MS12-027 installed.

Keep in mind, and I cannot say this often enough:

Do not change stuff in the Registry unless you are absolutely sure about what you are doing.

For each control you use from MSCOMCTL.OCX you need to add a Key under “HKLM\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility“. The value for each Key is in the following table:

CLSID in new MSCOMCTL.OCX Exposed Component Name
{87DACC48-F1C5-4AF3-84BA-A2A72C2AB959} Microsoft ImageComboBox Control 6.0 (SP6)
{F91CAF91-225B-43A7-BB9E-472F991FC402} Microsoft ImageList Control 6.0 (SP6)
{979127D3-7D01-4FDE-AF65-A698091468AF} Microsoft ListView Control 6.0 (SP6)
{A0E7BF67-8D30-4620-8825-7111714C7CAB} Microsoft ProgressBar Control 6.0 (SP6)
{0B314611-2C19-4AB4-8513-A6EEA569D3C4} Microsoft Slider Control 6.0 (SP6)
{627C8B79-918A-4C5C-9E19-20F66BF30B86} Microsoft StatusBar Control 6.0 (SP6)
{24B224E0-9545-4A2F-ABD5-86AA8A849385} Microsoft TabStrip Control 6.0 (SP6)
{7DC6F291-BF55-4E50-B619-EF672D9DCC58} Microsoft Toolbar Control 6.0 (SP6)
{95F0B3BE-E8AC-4995-9DCA-419849E06410} Microsoft TreeView Control 6.0 (SP6)

Inside each newly created key you must add 2 values, a REG_SZ named AlternateCLSID and a DWORD (32bit) value named Compatibility Flags (remember to includes the space between the 2 words). For convenience (and for finding my hack back quickly) I have added a third REG_SZ value using my name.

Value Name Value Type Value
AlternateCLSID REG_SZ {CLSID of the “old” component including braces}
Compatibility Flags DWORD 0x00000400 (1024)
Dutch.Gemini REG_SZ Backwards compatibility for component ‘whatever’ following MS012-027 (MSCOMCTL.OCX)

To find the old CLSID values, search for the control’s name (2nd column in 1st table) under the Registry branch “HKEY_CLASSES_ROOT\CLSID“. Watch out: the same component may have been registered multiple times with different CLSID’s, which occurs when you install updated versions of MSCOMCTL.OCX on the PC. For instance this is the case on my PC with the ListView component . So you may have to make a few attempts before you get it all back working.

Tip: the quickest way to understand what CLSID your system is using is looking for the component’s class name (e.g. MSComctlLib.ListViewCtrl) under “HKEY_CLASSES_ROOT“, read its CurVer key value, locate that key value under the same branch and from that one take the CLSID Key value:

The following registry script redirects the CLSID’s of the patched MSCOMCTL.OCX v6.1.98.33 of November 3, 2011 back to those exposed by v6.1.95.45 of December 20, 2002:

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{0B314611-2C19-4AB4-8513-A6EEA569D3C4}]
"AlternateCLSID"="{F08DF954-8592-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft Slider Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{24B224E0-9545-4A2F-ABD5-86AA8A849385}]
"AlternateCLSID"="{1EFB6596-857C-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft TabStrip Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{627C8B79-918A-4C5C-9E19-20F66BF30B86}]
"AlternateCLSID"="{8E3867A3-8586-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft StatusBar Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{7DC6F291-BF55-4E50-B619-EF672D9DCC58}]
"AlternateCLSID"="{66833FE6-8583-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft Toolbar Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{87DACC48-F1C5-4AF3-84BA-A2A72C2AB959}]
"AlternateCLSID"="{DD9DA666-8594-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft ImageComboBox Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{95F0B3BE-E8AC-4995-9DCA-419849E06410}]
"AlternateCLSID"="{C74190B6-8589-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft TreeView Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{979127D3-7D01-4FDE-AF65-A698091468AF}]
"AlternateCLSID"="{BDD1F04B-858B-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft ListView Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{A0E7BF67-8D30-4620-8825-7111714C7CAB}]
"AlternateCLSID"="{35053A22-8589-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft ProgressBar Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{F91CAF91-225B-43A7-BB9E-472F991FC402}]
"AlternateCLSID"="{2C247F23-8591-11D1-B16A-00C0F0283628}"
"Compatibility Flags"=dword:00000400
"Dutch.Gemini"="Backwards compatibility for Microsoft ImageList Control 6.0 (SP6) component following MS012-027 (MSCOMCTL.OCX)"

The following script removes the above keys and values:

Windows Registry Editor Version 5.00

[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{0B314611-2C19-4AB4-8513-A6EEA569D3C4}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{24B224E0-9545-4A2F-ABD5-86AA8A849385}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{627C8B79-918A-4C5C-9E19-20F66BF30B86}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{7DC6F291-BF55-4E50-B619-EF672D9DCC58}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{87DACC48-F1C5-4AF3-84BA-A2A72C2AB959}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{95F0B3BE-E8AC-4995-9DCA-419849E06410}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{979127D3-7D01-4FDE-AF65-A698091468AF}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{A0E7BF67-8D30-4620-8825-7111714C7CAB}]
[-HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility\{F91CAF91-225B-43A7-BB9E-472F991FC402}]

Just a last reminder: the above instructions only help you out of a quirky situation. You should patch your PC to the latest versions available as soon as you can.

How does ActiveX redirect on my PC?

The following code for Excel/VBA can be used to understand how ActiveX redirection is on set on your PC. Copy it in a module of your document (Thisworkbook is ok) and let it run.

Option Explicit

Sub Main()
Dim strComputer As String
Dim oReg As Object
Dim strKeyPath As String
Dim strCompName As String
Dim arrSubKeys As Variant
Dim subkey As Variant
Dim strAltClsId As String
Dim strValue As String
Dim rownum As Long

Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_LOCAL_MACHINE = &H80000002

Application.Cursor = xlWait

strComputer = "."

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv")

strKeyPath = "SOFTWARE\Microsoft\Internet Explorer\ActiveX Compatibility"

oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys

ActiveSheet.Cells.Clear
ActiveSheet.Range("A1").Value = "CLSID"
ActiveSheet.Range("B1").Value = "Component"
ActiveSheet.Range("C1").Value = "Path"
ActiveSheet.Range("D1").Value = "AlternateCLSID"
ActiveSheet.Range("E1").Value = "Component"
ActiveSheet.Range("F1").Value = "Path"
ActiveSheet.Range("G1").Value = "AlternateCLSID"
ActiveSheet.Range("H1").Value = "Component"
ActiveSheet.Range("I1").Value = "Path"
ActiveSheet.Range("J1").Value = "AlternateCLSID"

rownum = 2

On Error Resume Next

For Each subkey In arrSubKeys
    ' get component name and file
    strCompName = vbNullString
    strValue = vbNullString
    oReg.GetStringValue HKEY_CLASSES_ROOT, "CLSID\" & subkey, "", strCompName
    oReg.GetStringValue HKEY_CLASSES_ROOT, "CLSID\" & subkey & "\InprocServer32", "", strValue
    If (strCompName = "") Then GoTo NextSubKey ' class does not exist

    ActiveSheet.Range("A" & rownum).Value = subkey
    ActiveSheet.Range("B" & rownum).Value = strCompName
    ActiveSheet.Range("C" & rownum).Value = strValue

    ' get alternate CLSID.
    strAltClsId = vbNullString
    oReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & subkey, "AlternateCLSID", strAltClsId
    If (strAltClsId = "") Then GoTo NextValue ' alternate does not exist

    ActiveSheet.Range("D" & rownum).Value = strAltClsId

    ' get component name and file
    strCompName = vbNullString
    oReg.GetStringValue HKEY_CLASSES_ROOT, "CLSID\" & strAltClsId, "", strCompName
    oReg.GetStringValue HKEY_CLASSES_ROOT, "CLSID\" & strAltClsId & "\InprocServer32", "", strValue
    If (strCompName = "") Then GoTo NextValue ' alternate does not exist

    ActiveSheet.Range("E" & rownum).Value = strCompName
    ActiveSheet.Range("F" & rownum).Value = strValue

    ' this one also remapped?
    strValue = vbNullString
    oReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & strAltClsId, "AlternateCLSID", strValue
    If (strValue = "") Then GoTo NextValue ' alternate of alternate does not exist
    ActiveSheet.Range("G" & rownum).Value = strValue

    ' get component name and file
    strAltClsId = strValue
    strCompName = vbNullString
    strValue = vbNullString
    oReg.GetStringValue HKEY_CLASSES_ROOT, "CLSID\" & strAltClsId, "", strCompName
    oReg.GetStringValue HKEY_CLASSES_ROOT, "CLSID\" & strAltClsId & "\InprocServer32", "", strValue
    If (strCompName = "") Then GoTo NextValue ' alternate of alternate does not exist

    ActiveSheet.Range("H" & rownum).Value = strCompName
    ActiveSheet.Range("I" & rownum).Value = strValue

    ' this one also remapped?
    strValue = vbNullString
    oReg.GetStringValue HKEY_LOCAL_MACHINE, strKeyPath & "\" & strAltClsId, "AlternateCLSID", strValue
    If (strValue = "") Then GoTo NextValue ' alternate of alternate does not exist
    ActiveSheet.Range("J" & rownum).Value = strValue

NextValue:
    rownum = rownum + 1

NextSubKey:
Next

ActiveSheet.Range("A1").Sort Header:=xlYes, _
                             Key1:=ActiveSheet.Columns("C"), Order1:=xlAscending, _
                             Key2:=ActiveSheet.Columns("B"), Order2:=xlAscending
ActiveSheet.Columns.AutoFit

Application.Cursor = xlDefault
End Sub

Click this link to download an Excel 97-2003 compatible XLS file with the same code. Open and enable macros, press Alt-F8, select ThisWorkbook.Main and click Run.

December 17, 2010

How to develop a ListView with Tristate checkboxes on Excel’s Userform

Filed under: Excel,Programming,VBA — dutchgemini @ 3:31 pm
Tags: , , , ,

In an Excel Add-In application I’m developing I need to provide a way to set options to a variable amount elements I’m dealing with.  The elements are stored in a ListView ActiveX (from MSComCtlLib). The interface permits a partial selection of the elements and on this partial selection I want to provide the mentioned functionality. In practice, the user makes a selection, calls a dialog with a certain amount of options, sets whatever option and saves.

To deal not only with the previous setting of the options but also with the possibility to ignore an option for the selected elements, I use a TriState checkbox. Just to remind, a Tristate checkbox has the following 3 values:

  1. False meaning not checked displaying an empty box,
  2. Null meaning indeterminate displaying a grayed checkmark, and
  3. True which means checked displaying a black checkmark.

As long as the options you can set is known and fixed, you can populate the options dialog with a static amount of Tristate checkboxes and query their individual value when the user confirms, that is, if unchecked turn option off, if checked then turn on and if indetermined (i.e. Null) leave that option to its previous state (on or off).

The problems start when the amount of options available is determined dynamically. Although it possible to add controls at run-time, at some point you will reach the practical limits of the Userform, not to mention not being able to craft a decent UI without too much effort.

I did not want to create controls at run-time -and honestly couldn’t- since I estimated the options to be 30 or more. Unfortunately, Excel and VBA do not offer the PictureBox available in VB that I would have used to create a scrollable container with the variable amount of checkboxes. Developing a custom UI ActiveX was also not an option (mainly because I did not want to distribute a DLL aside my application.

So  I investigated the possibility of using a ListView with checkboxes. Initially it looked nice, but soon I discovered that the checkboxes did not accept the triple state and also that they were pretty disappointing graphically (no 3D-look as with a regular checkbox control). Trying to play with the font and the foreground colour of the ListView item didn’t work out well because the of the highlight, inherited from Windows.

I finally decided to abandon the checkboxes in the ListView and use an ImageList control instead, containing the 3 icons for unchecked (Id 1), indetermined (Id 2) and checked (Id 3) state. I obtained the 3 icons using a Tristate checkbox as a template, the [Alt+PrtSc] button to capture the screen and Paint for saving them to Gif so that I could have a transparent background. All images are 16 x 16.

ImageList TriState Checkbox Images

ImageList TriState Checkbox Images

Seeing the result, I must admit that it outperforms my expectations:

ListView with TriState Checkboxes

ListView with TriState Checkboxes

To replicate this dialog, insert a Userform to your project. On this Userform add a ListView (using the Microsoft ListView Control, version 6.0) and an ImageList (using the Microsoft ImageList Control, version 6.0) populated as in the first image. Open the code section and paste the following code:

Option Explicit

' Used for the screen metrics (see function ConvertPixelsToTwips at the bottom).
'
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long

Private mListItem As MSComctlLib.ListItem   ' Used for the Mouse clicks on the listview items

Private Sub ListView1_KeyUp(KeyCode As Integer, ByVal Shift As Integer)
On Error Resume Next
    ' Dehighlight whatever was highlighted.
    '
    ListView1.SelectedItem.Selected = False

    If (KeyCode = vbKeySpace) And (Shift = 0) _
    Then
        ' SpaceBar pressed all alone. Switch image.
        '
        With ListView1.SelectedItem
            If (.SmallIcon = 3) _
            Then .SmallIcon = 1 _
            Else .SmallIcon = (.SmallIcon + 1)
        End With
    End If

    ' Dehighlight whatever was highlighted.
    '
    ListView1.SelectedItem.Selected = False
End Sub

Private Sub ListView1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, _
                                ByVal x As stdole.OLE_XPOS_PIXELS, _
                                ByVal y As stdole.OLE_YPOS_PIXELS)
On Error Resume Next
    Dim wListItem As MSComctlLib.ListItem

    ' Dehighlight whatever was highlighted.
    '
    ListView1.SelectedItem.Selected = False

    ' Mark the item under the mouse pointer (used below).
    '
    ConvertPixelsToTwips x, y
    Set mListItem = ListView1.HitTest(x, y)
End Sub

Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                               ByVal x As stdole.OLE_XPOS_PIXELS, _
                               ByVal y As stdole.OLE_YPOS_PIXELS)
On Error Resume Next
    Dim wListItem As MSComctlLib.ListItem

    ' Dehighlight whatever was highlighted.
    '
    ListView1.SelectedItem.Selected = False

    ' Nothing under the mouse? Forget about the previous item (see above).
    '
    ConvertPixelsToTwips x, y
    If ListView1.HitTest(x, y) Is Nothing Then Set mListItem = Nothing

    ' There was no previous item (see above) so we quit.
    '
    If mListItem Is Nothing Then Exit Sub

    ' Check if the item under the mouse pointer is the one we clicked on (see above).
    '
    If (mListItem.Text = ListView1.HitTest(x, y).Text) _
    Then
        ' Yes, switch image.
        '
        With mListItem
            If (.SmallIcon = 3) _
            Then .SmallIcon = 1 _
            Else .SmallIcon = (.SmallIcon + 1)
        End With
    Else
        ' No, de-select and forget.
        '
        mListItem.Selected = False
        Set mListItem = Nothing
    End If
End Sub

Private Sub UserForm_Initialize()
On Error Resume Next
    Dim wListItem As MSComctlLib.ListItem
    Dim i         As Long

    ' Initialise the ListView.
    '
    ListView1.HideColumnHeaders = False
    ListView1.ColumnHeaders.Add Text:="Filters", Width:=160
    ListView1.View = lvwReport
    ListView1.SmallIcons = ImageList1

    ' Load 3 elements in the ListView.
    '
    For i = 1 To 3
        Set wListItem = ListView1.ListItems.Add(Text:="Filter " & i)
        wListItem.SmallIcon = 1 ' Unchecked
        wListItem.Selected = False
    Next i
End Sub

' ------------------------------------------------------
' This function converts screen pixels (device dependent) to Twips (used a.o. by ListView).
' ------------------------------------------------------
'
Private Sub ConvertPixelsToTwips(ByRef x As stdole.OLE_XPOS_PIXELS, _
                                 ByRef y As stdole.OLE_YPOS_PIXELS)
On Error Resume Next
    Dim hDC            As Long
    Dim RetVal         As Long
    Dim TwipsPerPixelX As Long
    Dim TwipsPerPixelY As Long
    Const LOGPIXELSX = 88
    Const LOGPIXELSY = 90
    Const TWIPSPERINCH = 1440

    hDC = GetDC(0)
    TwipsPerPixelX = TWIPSPERINCH / GetDeviceCaps(hDC, LOGPIXELSX)
    TwipsPerPixelY = TWIPSPERINCH / GetDeviceCaps(hDC, LOGPIXELSY)
    RetVal = ReleaseDC(0, hDC)
    x = x * TwipsPerPixelX
    y = y * TwipsPerPixelY
End Sub

As you can notice, there is a conversion of the [X,Y] coordinates before running the HitTest() method. This conversion is necessary because Excel provides pixels in the mouse events, and the ListView requires Twips.

Enjoy,

Dutch.

December 30, 2008

Popup Menu on a Userform in Excel with VBA

Filed under: Excel,Programming,VBA — dutchgemini @ 8:52 pm
Tags: , , , , , ,

Article reviewed on July 05, 2012 – Contains working project at the end (link).

Ever thought possible to show a popup menu on an MSComCtl.ListView placed on a UserForm within an Excel Add-In (the ones ending with .XLA) using a right-click of the mouse, “just” VBA and no other Win32 function, class or wrapper? No? Then continue reading. If you think it is possible but you never tried or do not know how, read as well.

In my daily struggling with VBA I came finally on the “Golden Tip” that made it all possible. And, this method works on any type of control you place on the UserForm, as long as it can intercept mouse clicks (left, middle or right button is a matter of your choice).

History
I am developing an Add-In for Excel connecting to a database. The Add-In retrieves the data in pure or in aggregated form and lets you place the result as a matrix (records are rows and fields are columns) on a worksheet. The definition of what the Add-In retrieves from the database is defined as ‘query’. The query is also stored in the workbook, in a [very] hidden worksheet.

One of the features of the Add-In is allowing to slice and trim the result of a query by fetching only a few single rows of the resulting (ADODB) RecordSet. The slice and trim is defined as a ‘restriction’. The restrictions are managed via a UserForm which has the ListView with the individual restrictions in it.

Wish
My desire was adding a right-click popup menu letting me establish the logical link between a list item and its predecessor, selecting from this menu the ‘AND’ or the ‘OR’. I did not want to add another button control to avoid overloading the form (I already have 5 of such).

First implementation
After some investigation in Excel’s and MSDN’s help, I bounced into a popup menu provided natively by Excel via a CommandBar objects. I decided to use it. To obtain the functionality of the right-click popup menu on the ListView on my UserForm, I used:

  • The MouseUp Event of the ListView, where I could trap the right click and identify the current selected list item;
  • A CommandBar as the menu container, to be activated via the ‘.ShowPopup‘ method
  • Two CommandBarButtons to be placed ‘on’ the CommandBar, one for the AND and one for the OR
  • Subroutine for dealing with the factual changes, to be called via the ‘.OnAction‘ property of the CommandBarButton

In a popup menu, the 2 command bar buttons act as menu entries.

However, this code was not working. In other words, the popup menu did show, I could click but none of them triggered the execution of the associated subroutine procedures. Without raising any error. I was troubled.

Second and final implementation
On the Internet (which took some time in order to establish the right terms to feed into King Google) I got the hint I needed: instead of adding 2 generic command bar buttons, I had to create 2 private variables as command buttons in the declaration part of the UserForm using the ‘WithEvents’ to allow the buttons to react on my mouse click.

To make this example work, create a UserForm and place a ListView – a ListView ActiveX control 6.0, remember to add a reference in your project to Microsoft Common Controls 6.0 (SP6) – called ‘ListView1’. Somewhere in the code add one or more items to ListView1.

In the Declaration section of the UserForm:

Option Explicit ' Always recommended

Private WithEvents mButton1 As CommandBarButton ' Manages the first popup menu entry
Private WithEvents mButton2 As CommandBarButton ' Manages the second popup menu entry

In the MouseUp method of the ListView:

Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, _
                              ByVal x As stdole.OLE_XPOS_PIXELS, _
                              ByVal y As stdole.OLE_YPOS_PIXELS)
On Error Resume Next
    Dim wListItem    As MSComctlLib.ListItem
    Dim wListItemTag As String

    ' We intercept only the 'RightClick' without any button pressed.
    '
    If (Button <> xlSecondaryButton) Or (Shift <> 0) Then GoTo EndSub

    ' Locate the element. We have used the Tooltip to know if this element needs to be modified.
    '
    Set wListItem = lstCustomRestrictions.SelectedItem
    If wListItem Is Nothing Then Set wListItem = lstCustomRestrictions.HitTest(x, y)
    If wListItem Is Nothing Then GoTo EndSub

    ' This line protects the first entry in the ListView.
    '
    If (wListItem.Index = 1) Then GoTo EndSub

    wListItem.Selected = True
    wListItemTag = wListItem.Tag  ' The Tag contains a specially crafted object.

    ' Show the popup menu.
    '
    ShowPopupMenu wListItemTag    ' The 'Tag' indicates 'Time' or 'Dutch'.

EndSub:
    Set wListItem = Nothing
End Sub

The Click event of the 2 buttons declared in the form:

Private Sub mButton1_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error Resume Next
    If (Ctrl.State = msoButtonDown) _
    Then
        ' It was down, i.e. 'checked', so we need to uncheck and void.
        '
        SetToolTipText vbNullString
    Else
        ' It was up, i.e. 'unchecked', so we need to check and set.
        '
        SetToolTipText Ctrl.Parameter
    End If
End Sub

Private Sub mButton2_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
On Error Resume Next
    If (Ctrl.State = msoButtonDown) _
    Then
        ' It was down, i.e. 'checked', so we need to uncheck and void.
        '
        SetToolTipText vbNullString
    Else
        ' It was up, i.e. 'unchecked', so we need to check and set.
        '
        SetToolTipText Ctrl.Parameter
    End If
End Sub

This is the first custom private procedure (called from the MouseUp subroutine):

Private Sub ShowPopupMenu(pLinkType As String)
On Error Resume Next
    Dim wPopupMenu As Office.CommandBar    ' Used for right-click on ListView1
    Dim wListItem  As MSComctlLib.ListItem

    ' First try to locate this commandbar. If it exists, then we destroy ad make it again.
    ' The name of the menu is not important but should be unique.
    '
    Set wPopupMenu = Application.CommandBars.Item("UserForm1Popup")
    If Not wPopupMenu Is Nothing _
    Then
        wPopupMenu.Delete
        Set wPopupMenu = Nothing
    End If

    ' Create the menu.
    '
    Set wPopupMenu = Application.CommandBars.Add(Name:="UserForm1Popup", _
                                                 Position:=msoBarPopup, _
                                                 Temporary:=True)
    wPopupMenu.Enabled = True

    ' Add the first child menu item to the popup
    '
    Set mButton1 = Nothing
    Set mButton1 = wPopupMenu.Controls.Add(Type:=msoControlButton, ID:=1, _
                                           Parameter:="Time", Temporary:=True)
    With mButton1
        .Caption = "Set Tooltip to current date/time (i.e. 'Now')"
        .Enabled = True
        If (pLinkType = "Time") _
        Then
            .FaceId = 990           ' Show check mark
            .State = msoButtonDown  ' Show pressed
        End If
        .Style = msoButtonIconAndCaption
        .Visible = True
    End With

    ' Add the second child menu item to the popup
    '
    Set mButton2 = Nothing
    Set mButton2 = wPopupMenu.Controls.Add(Type:=msoControlButton, ID:=1, _
                                           Parameter:="Dutch", Temporary:=True)
    With mButton2
        .Caption = "Set Tooltip to 'Dutch Gemini'"
        .Enabled = True
        If (pLinkType = "Dutch") _
        Then
            .FaceId = 990           ' Show check mark
            .State = msoButtonDown  ' Show pressed
        End If
        .Style = msoButtonIconAndCaption
        .Visible = True
    End With

    ' Show as a popup close to the mouse pointer.
    '
    wPopupMenu.ShowPopup

    ' Destroy the internal popup menu.
    '
    If Not wPopupMenu Is Nothing Then wPopupMenu.Delete
    Set mButton2 = Nothing
    Set mButton1 = Nothing
    Set wPopupMenu = Nothing
End Sub

And the second custom private procedure:

Private Sub SetToolTipText(pToolTipType As String)
On Error Resume Next
    Dim wListItem As MSComctlLib.ListItem

    Set wListItem = ListView1.SelectedItem
    If wListItem Is Nothing Then GoTo EndSub

    ' This line protects the first entry in the ListView.
    '
    If (wListItem.Index = 1) Then GoTo EndSub

    wListItem.Tag = pToolTipType
    Select Case pToolTipType
    Case "Time"
        wListItem.TooltipText = VBA.CStr(Now)
    Case "Dutch"
        wListItem.TooltipText = "Dutch Gemini"
    Case Else
        wListItem.TooltipText = ""
    End Select

    wListItem.Selected = False

EndSub:
    Set wListItem = Nothing
End Sub

That’s it.

For convenience I have made this sample project available as an Excel workbook which contains the necessary overhead for making the above work out-of-the-box. It also contains some code dealing with the positioning of the UserForm on multiple-monitor systems. Click here to download a copy of this document.

If you like it then you can make me aware of your appreciation by making a small donation to help supporting my work.

Blog at WordPress.com.