View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
[email protected] jasonbates@gmail.com is offline
external usenet poster
 
Posts: 4
Default Combo box macro problems

Guys,

I've been using a pretty useful worksheet macro that creates combo
boxes
to replace list boxes for selection and validation when you double
click on a cell...
(it's useful because I can create wider, longer lists, different fonts,
and works on all of the validation drop downs on the spreadsheet).
Unfortunately after some heavy calculation macro's the double click
event seems to stop working

From what I've read in this forum I think that the problem may be to do

with with Garbage collection.

My question... what is the simplest code I need to add to my excel
workbook to stop this from happening... can I just define the combo box
object somewhere globally?

I'm a neohpyte with excel VBA so please be gentle..... Thanks in
advance

JB

--- the code that resides in the sheet ---

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel
As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")

On Error Resume Next
With cboTemp
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With

On Error GoTo errHandler
If Target.Validation.Type = 3 Then
Application.EnableEvents = False
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub

* * * *

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub