View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Pflugs Pflugs is offline
external usenet poster
 
Posts: 167
Default Refedit Retaining Focus

I see. I tried changing the event type, but I am still having the same
problem. Sometimes the form closes all by itself and sometimes when I close
it, it seems to remain loaded. Then if it runs again, Excel crashes.

I am including the code for the form below. The macro that calls it is only
sliderForm.show

==============================================

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} sliderForm
Caption = "Super Slider"
ClientHeight = 4200
ClientLeft = 45
ClientTop = 435
ClientWidth = 4095
OleObjectBlob = "sliderForm.frx":0000
StartUpPosition = 1 'CenterOwner
End
Attribute VB_Name = "sliderForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
With Me
If .ActiveControl.Name = "RefEdit1" Then .lblOriginal1.SetFocus
Application.CutCopyMode = False
End With
End Sub

Private Sub UserForm_Initialize()
With Me
.lblIncrement1.Enabled = False
.tbIncrement1.Enabled = False
.scroll1.Enabled = False
If ActiveCell.Value < "" Then .RefEdit1.Value = Selection.Address

.lblIncrement2.Enabled = False
.tbIncrement2.Enabled = False
.scroll2.Enabled = False
If ActiveCell.Offset(1, 0).Value < "" Then
.RefEdit2.Value = ActiveCell.Offset(1, 0).Address
ElseIf ActiveCell.Offset(0, 1).Value < "" Then
.RefEdit2.Value = ActiveCell.Offset(0, 1).Address
End If
.RefEdit1.SetFocus
End With

End Sub

Private Sub cbxTwoCells_Click()
With Me
If .cbxTwoCells Then
.Width = 408
.frSel2.Enabled = True
Else
.Width = 210
.frSel2.Enabled = False
End If
End With
End Sub

'******** Here starts the code for the first selection.

Private Sub cbDone_Click()
Me.cbxTwoCells.SetFocus
Unload Me
End Sub

Private Sub cbReset1_Click()
If Not Me.RefEdit1.Value = "" Then Range(Me.RefEdit1.Value).Value =
Me.tbOriginal1.Value
If Not (Me.RefEdit1.Value = "" Or Me.tbMin1.Value = "" Or
Me.tbStep1.Value = "") Then Me.scroll1.Value =
Int((Range(Me.RefEdit1.Value).Value - Me.tbMin1.Value) / Me.tbStep1)
End Sub

Private Sub cbSet1_Click()
Dim cell1 As Range
If Me.RefEdit1.Value < "" Then Set cell1 = Range(Me.RefEdit1.Value)

Dim ctrl As MSForms.Control
Dim curVal As Double

With Me
For Each ctrl In .frSel1.Controls
Debug.Print TypeName(ctrl)
Debug.Print ctrl.Name
If TypeName(ctrl) = "TextBox" Then
If ctrl.Value = "" Then GoTo notEnough
End If
Next ctrl

If .RefEdit1.Value = "" Then GoTo notEnough
curVal = cell1.Value

If .tbStep1.Value <= 0 Then
msg = "The step size may not be less an or equal to 0. " & _
"Please enter a new step size."
style = vbOKOnly + vbCritical
title = "Step Size Error"
response = MsgBox(msg, style, title)
.tbStep1.Value = ""
.tbStep1.SetFocus
Exit Sub
End If

.scroll1.Min = 0
.scroll1.Max = (.tbMax1.Value - .tbMin1.Value) / .tbStep1
If .scroll1.Max 32767 Then
msg = "The specified step size is too small. Please enter " & _
"a smaller value."
style = vbOKOnly + vbCritical
title = "Step Size Error"
response = MsgBox(msg, style, title)
.tbStep1.Value = ""
.tbStep1.SetFocus
Exit Sub
End If

If CDbl(.tbStep1) .tbMax1 - .tbMin1 Then
Stop
msg = "The specified step size is greater than the input range.
" & _
"Please enter a smaller value."
style = vbOKOnly + vbCritical
title = "Step Size Error"
response = MsgBox(msg, style, title)
.tbStep1.Value = ""
.tbStep1.SetFocus
Exit Sub
End If

.scroll1.SmallChange = 1
If .scroll1.Max - .scroll1.Min 10 Then
.scroll1.LargeChange = 10
Else
.scroll1.LargeChange = 1
End If

'.scroll1.Max * .tbStep1 + .tbMin1.Value
If .tbMax1 < curVal Then
msg = "Your current value is greater than your slider maximum.
" & _
"Choose 'Okay' to set the current value equal to the
maximum or " & _
"click 'Cancel' to enter a new maximum slider value."
style = vbCritical + vbOKCancel
title = "Range Error"
response = MsgBox(msg, style, title)
If response = vbOK Then
Range(Me.RefEdit1.Value).Value = .tbMax1.Value
.scroll1.Value = .scroll1.Max
.tbOriginal1.Value = Range(Me.RefEdit1.Value).Value
Else
.tbMax1.Value = ""
.tbMax1.SetFocus
Exit Sub
End If
ElseIf .tbMin1.Value curVal Then
msg = "Your current value is less than your slider minimum. " & _
"Choose 'Okay' to set the current value equal to the
minimum " & _
"or click 'Cancel' to enter a new minimum slider value."
style = vbCritical + vbOKCancel
title = "Range Error"
response = MsgBox(msg, style, title)
If response = vbOK Then
Range(Me.RefEdit1.Value).Value = .tbMin1.Value
.scroll1.Value = .scroll1.Min
.tbOriginal1.Value = Range(Me.RefEdit1.Value).Value
Else
.tbMin1.Value = ""
.tbMin1.SetFocus
Exit Sub
End If
Else
.scroll1.Value = Int((Range(Me.RefEdit1.Value).Value -
..tbMin1.Value) / .tbStep1)
End If

.scroll1.Enabled = True
End With

Me.tbOriginal1.Value = Range(Me.RefEdit1.Value).Value

Exit Sub

notEnough:
response = MsgBox("You haven't entered all the necessary information. "
& _
"Please complete the entire form.", vbCritical +
vbOKOnly, "More Information Needed")

End Sub

Private Sub cbxIncrement1_Click()
With Me
If .cbxIncrement1.Value Then
.tbStep1.Enabled = False
.tbStep1.Locked = True
.tbStep1.Value = ""
.tbIncrement1.Enabled = True
.tbIncrement1.Locked = False
.tbIncrement1.Value = ""
.lblIncrement1.Enabled = True
.lblStep1.Enabled = False
Else
.tbStep1.Enabled = True
.tbStep1.Locked = False
.tbStep1.Value = ""
.tbIncrement1.Enabled = False
.tbIncrement1.Locked = True
.tbIncrement1.Value = ""
.lblIncrement1.Enabled = False
.lblStep1.Enabled = True
End If
End With
End Sub


Private Sub RefEdit1_Change()
Me.scroll1.Enabled = False
Me.tbOriginal1.Value = Range(Me.RefEdit1.Value).Cells(1, 1).Value
End Sub

Private Sub scroll1_Change()
With Me
If .scroll1.Enabled Then
If .scroll1 = .scroll1.Max Then
Range(.RefEdit1.Value).Value = CDbl(.tbMax1)
Else
Range(.RefEdit1.Value).Value = CDbl(.scroll1.Value *
..tbStep1 + .tbMin1.Value)
End If
End If
End With
End Sub

Private Sub scroll1_Scroll()
With Me
If .scroll1.Enabled Then
If .scroll1 = .scroll1.Max Then
Range(.RefEdit1.Value).Value = CDbl(.tbMax1)
Else
Range(.RefEdit1.Value).Value = CDbl(.scroll1.Value *
..tbStep1 + .tbMin1.Value)
End If
End If
End With
End Sub

Private Sub tbIncrement1_Change()
With Me
.scroll1.Enabled = False
If .cbxIncrement1.Value Then
.tbStep1.Value = getStepSize
Else
.tbIncrement1.Value = getIncrements
End If
End With
End Sub

Private Sub tbMax1_Change()
With Me
.scroll1.Enabled = False
If .cbxIncrement1.Value Then
.tbStep1.Value = getStepSize
Else
.tbIncrement1.Value = getIncrements
End If
End With
End Sub

Private Sub tbMin1_Change()
With Me
.scroll1.Enabled = False
If .cbxIncrement1.Value Then
.tbStep1.Value = getStepSize
Else
.tbIncrement1.Value = getIncrements
End If
End With
End Sub

Private Sub tbStep1_Change()
With Me
.scroll1.Enabled = False
If .cbxIncrement1.Value Then
.tbStep1.Value = getStepSize
Else
.tbIncrement1.Value = getIncrements
End If
End With
End Sub

Function getIncrements() As String
On Error GoTo error
With Me
getIncrements = Int((.tbMax1 - .tbMin1) / .tbStep1)
End With
Exit Function

error:
getIncrements = ""
End Function

Function getStepSize() As String
On Error GoTo error
With Me
getStepSize = format((.tbMax1 - .tbMin1) / .tbIncrement1, "#.###")
End With
Exit Function

error:
getStepSize = ""
End Function




'********* Here starts the code for the second selection

Private Sub cbReset2_Click()
With Me
If Not .RefEdit2.Value = "" Then Range(.RefEdit2.Value).Value =
..tbOriginal1.Value
If Not (.RefEdit2.Value = "" Or .tbMin2.Value = "" Or .tbStep2.Value =
"") Then .scroll2.Value = Int((Range(.RefEdit1.Value).Value - .tbMin2.Value)
/ .tbStep2)
End With
End Sub

Private Sub cbSet2_Click()
Dim cell2 As Range
If Me.RefEdit2.Value < "" Then Set cell2 = Range(Me.RefEdit2.Value)

Dim ctrl As MSForms.Control
Dim curVal As Double

With Me
For Each ctrl In .frSel2.Controls
Debug.Print TypeName(ctrl)
Debug.Print ctrl.Name
If TypeName(ctrl) = "TextBox" Then
If ctrl.Value = "" Then GoTo notEnough
End If
Next ctrl

If .RefEdit2.Value = "" Then GoTo notEnough
curVal = cell2.Value

If .tbStep2.Value <= 0 Then
msg = "The step size may not be less an or equal to 0. " & _
"Please enter a new step size."
style = vbOKOnly + vbCritical
title = "Step Size Error"
response = MsgBox(msg, style, title)
.tbStep2.Value = ""
.tbStep2.SetFocus
Exit Sub
End If

.scroll2.Min = 0
.scroll2.Max = (.tbMax2.Value - .tbMin2.Value) / .tbStep2
If .scroll2.Max 32767 Then
msg = "The specified step size is too small. Please enter " & _
"a smaller value."
style = vbOKOnly + vbCritical
title = "Step Size Error"
response = MsgBox(msg, style, title)
.tbStep2.Value = ""
.tbStep2.SetFocus
Exit Sub
End If

If CDbl(.tbStep2) .tbMax2 - .tbMin2 Then
Stop
msg = "The specified step size is greater than the input range.
" & _
"Please enter a smaller value."
style = vbOKOnly + vbCritical
title = "Step Size Error"
response = MsgBox(msg, style, title)
.tbStep2.Value = ""
.tbStep2.SetFocus
Exit Sub
End If

.scroll2.SmallChange = 1
If .scroll2.Max - .scroll2.Min 10 Then
.scroll2.LargeChange = 10
Else
.scroll2.LargeChange = 1
End If

'.scroll2.Max * .tbStep2 + .tbMin2.Value
If .tbMax2 < curVal Then
msg = "Your current value is greater than your slider maximum.
" & _
"Choose 'Okay' to set the current value equal to the
maximum or " & _
"click 'Cancel' to enter a new maximum slider value."
style = vbCritical + vbOKCancel
title = "Range Error"
response = MsgBox(msg, style, title)
If response = vbOK Then
Range(Me.RefEdit2.Value).Value = .tbMax2.Value
.scroll2.Value = .scroll2.Max
.tbOriginal2.Value = Range(Me.RefEdit2.Value).Value
Else
.tbMax2.Value = ""
.tbMax2.SetFocus
Exit Sub
End If
ElseIf .tbMin2.Value curVal Then
msg = "Your current value is less than your slider minimum. " & _
"Choose 'Okay' to set the current value equal to the
minimum " & _
"or click 'Cancel' to enter a new minimum slider value."
style = vbCritical + vbOKCancel
title = "Range Error"
response = MsgBox(msg, style, title)
If response = vbOK Then
Range(Me.RefEdit2.Value).Value = .tbMin2.Value
.scroll2.Value = .scroll2.Min
.tbOriginal2.Value = Range(Me.RefEdit2.Value).Value
Else
.tbMin2.Value = ""
.tbMin2.SetFocus
Exit Sub
End If
Else
.scroll2.Value = Int((Range(Me.RefEdit2.Value).Value -
..tbMin2.Value) / .tbStep2)
End If

.scroll2.Enabled = True
End With

Me.tbOriginal2.Value = Range(Me.RefEdit2.Value).Value

Exit Sub

notEnough:
response = MsgBox("You haven't entered all the necessary information. "
& _
"Please complete the entire form.", vbCritical +
vbOKOnly, "More Information Needed")

End Sub

Private Sub cbxIncrement2_Click()
With Me
If .cbxIncrement2.Value Then
.tbStep2.Enabled = False
.tbStep2.Locked = True
.tbStep2.Value = ""
.tbIncrement2.Enabled = True
.tbIncrement2.Locked = False
.tbIncrement2.Value = ""
.lblIncrement2.Enabled = True
.lblStep2.Enabled = False
Else
.tbStep2.Enabled = True
.tbStep2.Locked = False
.tbStep2.Value = ""
.tbIncrement2.Enabled = False
.tbIncrement2.Locked = True
.tbIncrement2.Value = ""
.lblIncrement2.Enabled = False
.lblStep2.Enabled = True
End If
End With
End Sub

Private Sub RefEdit2_Change()
Me.scroll2.Enabled = False
Me.tbOriginal2.Value = Range(Me.RefEdit2.Value).Cells(1, 1).Value
End Sub

Private Sub scroll2_Change()
With Me
If .scroll2.Enabled Then
If .scroll2 = .scroll2.Max Then
Range(.RefEdit2.Value).Value = CDbl(.tbMax2)
Else
Range(.RefEdit2.Value).Value = CDbl(.scroll2.Value *
..tbStep2 + .tbMin2.Value)
End If
End If
End With
End Sub

Private Sub scroll2_Scroll()
With Me
If .scroll2.Enabled Then
If .scroll2 = .scroll2.Max Then
Range(.RefEdit2.Value).Value = CDbl(.tbMax2)
Else
Range(.RefEdit2.Value).Value = CDbl(.scroll2.Value *
..tbStep2 + .tbMin2.Value)
End If
End If
End With
End Sub

Private Sub tbIncrement2_Change()
With Me
.scroll2.Enabled = False
If .cbxIncrement2.Value Then
.tbStep2.Value = getStepSize2
Else
.tbIncrement2.Value = getIncrements2
End If
End With
End Sub

Private Sub tbMax2_Change()
With Me
.scroll2.Enabled = False
If .cbxIncrement2.Value Then
.tbStep2.Value = getStepSize2
Else
.tbIncrement2.Value = getIncrements2
End If
End With
End Sub

Private Sub tbMin2_Change()
With Me
.scroll2.Enabled = False
If .cbxIncrement2.Value Then
.tbStep2.Value = getStepSize2
Else
.tbIncrement2.Value = getIncrements2
End If
End With
End Sub

Private Sub tbStep2_Change()
With Me
.scroll2.Enabled = False
If .cbxIncrement2.Value Then
.tbStep2.Value = getStepSize2
Else
.tbIncrement2.Value = getIncrements2
End If
End With
End Sub

Function getIncrements2() As String
On Error GoTo error
With Me
getIncrements2 = Int((.tbMax2 - .tbMin2) / .tbStep2)
End With
Exit Function

error:
getIncrements2 = ""
End Function

Function getStepSize2() As String
On Error GoTo error
With Me
getStepSize2 = format((.tbMax2 - .tbMin2) / .tbIncrement2, "#.###")
End With
Exit Function

error:
getStepSize2 = ""
End Function


==============================================


"Jim Rech" wrote:

I've had this problem and found changing focus helps:

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If ActiveControl.Name = "MyRefEdit" Then NamesListBox.SetFocus
End Sub

Doing it in the terminate event is too late I believe.

--
Jim
"Pflugs" wrote in message
...
|I created a userform that contains a RefEdit, several textboxes, and a
'Done'
| button. The form is initialized with the RefEdit as the focus. The form
| also has a checkbox that when clicked modifies the width to reveal a
second
| set of controls.
|
| Sometimes when I click 'Done' to close the form, the RefEdit's selection
| retains control. That is, the status bar says "Point" and the ants are
| marching around the selection. When this happens, the macro continues to
run
| and Excel becomes confused and eventually crashes.
|
| I'm not sure why this is happening. I have even used
| "Application.CutCopyMode = False" on Terminate, and that doesn't seem to
take
| care of all problems. I have also tried cleaning the code with Rob
Bovey's
| Code Cleaner. Any other suggestions?
|
| Thanks,
| Pflugs