Hi Rob,
Thanks for your offer - here is my code (hopefully not too long
winded). Note that I call 'SetMenuValue' from an object event to
populate the edit boxes with relevant numbers. Also, my previous
description wasn't quite accurate - the problem occurs whether there
is another workbook open or not, ie. the 'HandleEditBox' only fires
after first saving then closing and re-opening.
PS. Thanks for your CodeCleaner tool which I have found v. useful on a
number of occassions!
Andrew
' Create a new shortcut menu to display details about the field when
its icon
' is right clicked (format is same as the menu displayed when the
worksheet is
' right clicked)
' Menu is temporary so will be deleted when xl is closed
Public Sub CreateCstmMenu()
Dim cbr As CommandBar
Dim ctl As CommandBarControl
Dim cbt As CommandBarButton
Dim strCaption As String
Dim i As Integer
Dim astrMenus(5) As String
' Define the menus where we want an edit box _
(ensure that there is a macro for each of these controls)
astrMenus(0) = "Max_Rate"
astrMenus(1) = "Min_Rate"
astrMenus(2) = "Opt_Rate"
astrMenus(3) = "Priority"
astrMenus(4) = "CGR"
astrMenus(5) = "CO2"
' Delete the menu first incase it already exists
DeleteMenu
' Create the menu
Set cbr = Application.CommandBars.Add(g_strMENU_NAME, msoBarPopup,
, True)
' Add controls listed above to the menu
For i = UBound(astrMenus) To 0 Step -1
' Format the caption so edit boxes line up
Select Case i
Case 0, 2
strCaption = astrMenus(i)
Case 1
strCaption = astrMenus(i) & " "
Case 3
strCaption = astrMenus(i) & " "
Case Is >= 4
strCaption = astrMenus(i) & " "
End Select
' Add the control
Set ctl = Application.CommandBars(g_strMENU_NAME).Controls.Add
_
(Type:=msoControlEdit, Before:=1, Temporary:=True)
With ctl
.Caption = " " & strCaption
.OnAction = ThisWorkbook.Name & "!HandleEditBox"
.Text = "#N/A" 'default - update when field clicked
End With
Next
' Add the enabled ctl button
Set cbt = Application.CommandBars(g_strMENU_NAME).Controls.Add _
(Type:=msoControlButton, Before:=1, Temporary:=True)
With cbt
.Caption = "Enabled"
.FaceId = 990 'give the button a tick icon
.State = msoButtonDown 'show the field as enabled
.OnAction = ThisWorkbook.Name & "!Enabled"
End With
' Add a button to display field header
Set cbt = Application.CommandBars(g_strMENU_NAME).Controls.Add _
(Type:=msoControlButton, Before:=1, Temporary:=True)
With cbt
.Caption = "===== Jintan ====="
.Enabled = False
End With
End Sub
Public Sub DeleteMenu()
On Error Resume Next
Application.CommandBars(g_strMENU_NAME).Delete
End Sub
Sub SetMenuValue(intIndex As Integer, varNewValue As Variant)
'on error goto ErrTrap
Dim ctl As CommandBarControl
Set ctl = Application.CommandBars(g_strMENU_NAME).Controls(intIndex)
'title (only field which is not enabled)
If ctl.Enabled = False Then
ctl.Caption = "===== " & varNewValue & " ====="
'values
ElseIf ctl.Type = msoControlEdit Then
ctl.Text = CStr(varNewValue)
'enabled/disabled
ElseIf ctl.Type = msoControlButton Then
If varNewValue = False Then
ctl.FaceId = 840 'cross
ctl.State = msoButtonUp
Else
ctl.FaceId = 990
ctl.State = msoButtonDown
End If
End If
ErrTrap:
End Sub
' MACROS TO HANDLE CHANGES IN VALUES!!!!
Sub Enabled()
' Toggle enabled setting
g_objField.Enabled = Not (g_objField.Enabled)
End Sub
' NOTE - user MUST hit enter after entry has been made. OnAction is
not
' triggered if you just click back on the spreadsheet.
Public Sub HandleEditBox()
Dim ctlCaller As CommandBarControl
Dim sngPosLeft As Single
Dim sngPosTop As Single
Set ctlCaller = CommandBars.ActionControl
' Record menu position (so can redisplay menu)
sngPosLeft = ctlCaller.Parent.Left
sngPosTop = ctlCaller.Parent.Top
Select Case Trim(ctlCaller.Caption)
Case "Max_Rate"
' Transfer value to cField obj
g_objField.MaxRate = ctlCaller.Text
' Write value to set-up sheet
Range("Field1").Offset(g_objField.ID,
intOFFSET_TO_MAXRATE).Value = ctlCaller.Text
Case "Min_Rate"
' Transfer value to cField obj
g_objField.MinRate = ctlCaller.Text
' Write value to set-up sheet
Range("Field1").Offset(g_objField.ID,
intOFFSET_TO_MINRATE).Value = ctlCaller.Text
Case "Priority"
' Transfer value to cField obj
g_objField.Priority = ctlCaller.Text
' Write value to set-up sheet
Range("Field1").Offset(g_objField.ID,
intOFFSET_TO_PRIO).Value = ctlCaller.Text
Case "CO2"
' Transfer value to cField obj
g_objField.CO2 = ctlCaller.Text
' Write value to set-up sheet
Range("Field1").Offset(g_objField.ID,
intOFFSET_TO_CO2).Value = ctlCaller.Text
Case Else
' Don't allow changes to opt rate or CGR
Beep
End Select
' Re-display the menu again so user can see the change
'ctlCaller.Parent.ShowPopup sngPosLeft, sngPosTop 'found this to
be annoying
End Sub
