| |
WindowsXP、Excel2003 を使用しております。
ある特定のシートに対して、右クリックメニューの項目を編集しているのですが、
突然、メニュー内容がデフォルトに戻ってしまいます。
( commandBarへの編集が反映されなくなる。 )
上記状態になった後、デバッグ文をつっこんでcommandBar("Cell")のControls
の状態(Caption)を表示したところ、編集後のメニュー項目が表示されたため、
commandBarへの編集は問題なく行われています。
右クリックメニューの項目内容編集処理を実装しているBookすべてが
同じ状態になるわけではなく、ある特定のBookのシートのみ本事象が発生している
状態です。
commandBarの編集はうまくいっているので、これ以上の調査ネタが尽きて
しまい手詰まり状態です。
些細なことでもなにか気になった点や、本事象にめぐり合ったことがある方が
いましたらお力を貸して頂きたいです。
【気になる点】
・本事象が発生するシートには、大量データが書き込まれております。
⇒ 縦10 X 横8 の表が2行分のスペースを保ちながら、
1行目から10000行目まで縦にズラッと並んでおります。
(各セルには10文字程度の文字列が存在します。)
(各表ごと、名前定義が10個定義されています。)
以下にソースコードを掲載させて頂きます。
【 シートモジュール 】
Private Sub Worksheet_Activate()
Call contextMenu.Initialize
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Call contextMenu.eventBeforeRightClick(Target, Cancel)
End Sub
【 contextMenuモジュール 】
Private Const MENU_LABEL_COPY = "コピー(&C)"
Private Const MENU_LABEL_PASTE = "値の貼り付け(&V)"
Private Const MENU_LABEL_AAA = "AAA"
Private Const MENU_LABEL_BBB = "BBB"
Private Const MENU_LABEL_CCC = "CCC"
Private Const MENU_LABEL_DDD = "DDD"
Private Const MENU_LABEL_EEE = "EEE"
Public Sub Initialize()
Dim controlItem As Object
Dim cellCommandBar As CommandBar
Set cellCommandBar = Application.CommandBars("Cell")
For Each controlItem In cellCommandBar.Controls
If controlItem.Caption <> MENU_LABEL_COPY Then
controlItem.Delete
End If
Next controlItem
With cellCommandBar.Controls.add _
(Type:=msoControlButton)
.Caption = MENU_LABEL_PASTE
.OnAction = "'[任意関数P]'"
.FaceId = 22
End With
With cellCommandBar.Controls.add _
(Type:=msoControlButton)
.Caption = MENU_LABEL_AAA
.OnAction = "'[任意関数A]'"
.BeginGroup = True
End With
With cellCommandBar.Controls.add _
(Type:=msoControlButton)
.Caption = MENU_LABEL_BBB
.OnAction = "'[任意関数B]'"
.BeginGroup = False
End With
With cellCommandBar.Controls.add _
(Type:=msoControlButton)
.Caption = MENU_LABEL_CCC
.OnAction = "'[任意関数C]'"
.BeginGroup = False
End With
With cellCommandBar.Controls.add _
(Type:=msoControlButton)
.Caption = MENU_LABEL_DDD
.OnAction = "'[任意関数D]'"
.BeginGroup = False
End With
With cellCommandBar.Controls.add _
(Type:=msoControlButton)
.Caption = MENU_LABEL_EEE
.OnAction = "'[任意関数E]'"
.BeginGroup = False
End With
End Sub
Public Sub eventBeforeRightClick(ByVal Target As Range, ByRef Cancel As Boolean)
Dim beforeEnableEvents As Boolean
With Application
beforeEnableEvents = .EnableEvents
.EnableEvents = False
End With
Dim cellCommandBar As CommandBar
Set cellCommandBar = Application.CommandBars("Cell")
If 1 < Target.Areas.count Then
Dim controlItem As Object
For Each controlItem In cellCommandBar.Controls
controlItem.Enabled = False
Next
Else
With cellCommandBar
.Controls(MENU_LABEL_COPY).Enabled = True
If xlCopy = Application.CutCopyMode Then
.Controls(MENU_LABEL_PASTE).Enabled = True
Else
.Controls(MENU_LABEL_PASTE).Enabled = False
End If
If Target.name <> "任意レンジ名" Then
.Controls(MENU_LABEL_AAA).Enabled = True
.Controls(MENU_LABEL_BBB).Enabled = True
.Controls(MENU_LABEL_CCC).Enabled = True
.Controls(MENU_LABEL_DDD).Enabled = True
.Controls(MENU_LABEL_EEE).Enabled = True
Else
.Controls(MENU_LABEL_AAA).Enabled = False
.Controls(MENU_LABEL_BBB).Enabled = False
.Controls(MENU_LABEL_CCC).Enabled = False
.Controls(MENU_LABEL_DDD).Enabled = False
.Controls(MENU_LABEL_EEE).Enabled = False
End If
End With
End If
Application.EnableEvents = beforeEnableEvents
End Sub
以上。
|
|
ffssit
- 10/12/4(土) 23:43 -
