ed.ayers315
Board Regular
- Joined
- Dec 14, 2009
- Messages
- 166
Hi Folks
I tried to put together a couple of double click events the forum users "wigi" and "p45cal" provided with a couple self modification to get what I needed.
Now the problem is alone they work great but not on the same worksheet.
I would like to be able to use both on the same sheet. Any advise would be great!
Here is the code:
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
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left + 1
.Top = Target.Top + 1
.Width = Target.Width + 14
.Height = Target.Height
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
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
<o> </o>
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
<o> </o>
errHandler:
Application.EnableEvents = True
ActiveSheet.Shapes("TempCombo").Visible = True
<o> </o>
ActiveSheet.Calculate
ActiveWindow.SmallScroll
Application.WindowState = Application.WindowState
<o> </o>
Exit Sub
<o> </o>
End Sub
<o> </o>
<o> </o>
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("g21:h21,g23:h23,g25:h25,g27:h27,g29:h29,g31:h31,g33:h33,g35:h35,g37:h37,g39:h39,g41:h41,g43:h43,g48:h48,g50:h50,g52:h52,g54:h54,g56:h56,g58:h58,g60:h60,g62:h62,g64:h64,g66:h66")) Is Nothing Then
Cancel = True
If VarType(Target.Value) = vbBoolean Then
Target.Value = Not (Target.Value)
Else
Target.Value = IIf(Target.Value = 1, Null, 1)
End If
End If
End Sub
I tried to put together a couple of double click events the forum users "wigi" and "p45cal" provided with a couple self modification to get what I needed.
Now the problem is alone they work great but not on the same worksheet.
I would like to be able to use both on the same sheet. Any advise would be great!
Here is the code:
Code:
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
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left + 1
.Top = Target.Top + 1
.Width = Target.Width + 14
.Height = Target.Height
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If
errHandler:
Application.EnableEvents = True
Exit Sub
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
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
<o> </o>
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
<o> </o>
errHandler:
Application.EnableEvents = True
ActiveSheet.Shapes("TempCombo").Visible = True
<o> </o>
ActiveSheet.Calculate
ActiveWindow.SmallScroll
Application.WindowState = Application.WindowState
<o> </o>
Exit Sub
<o> </o>
End Sub
<o> </o>
<o> </o>
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("g21:h21,g23:h23,g25:h25,g27:h27,g29:h29,g31:h31,g33:h33,g35:h35,g37:h37,g39:h39,g41:h41,g43:h43,g48:h48,g50:h50,g52:h52,g54:h54,g56:h56,g58:h58,g60:h60,g62:h62,g64:h64,g66:h66")) Is Nothing Then
Cancel = True
If VarType(Target.Value) = vbBoolean Then
Target.Value = Not (Target.Value)
Else
Target.Value = IIf(Target.Value = 1, Null, 1)
End If
End If
End Sub
Code: