Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


14776 / 76734 ←次へ | 前へ→

【67446】右クリックメニューの編集内容が突然反映されなくなる
質問  ffssit  - 10/12/4(土) 23:43 -

引用なし
パスワード
   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


以上。

1 hits

【67446】右クリックメニューの編集内容が突然反映されなくなる ffssit 10/12/4(土) 23:43 質問
【67448】Re:右クリックメニューの編集内容が突然反... りん 10/12/5(日) 9:57 発言
【67449】Re:右クリックメニューの編集内容が突然反... ffssit 10/12/5(日) 16:44 発言
【67464】Re:右クリックメニューの編集内容が突然反... ffssit 10/12/6(月) 22:38 お礼

14776 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free