Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4446 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【56598】特定のシートに独自メニュを組み込む方法 操否 08/6/23(月) 17:32 質問[未読]
【56601】Re:特定のシートに独自メニュを組み込む方法 操否 08/6/23(月) 19:49 質問[未読]
【56602】Re:特定のシートに独自メニュを組み込む方法 りん 08/6/23(月) 20:26 発言[未読]
【56605】Re:特定のシートに独自メニュを組み込む方法 操否 08/6/24(火) 11:34 お礼[未読]
【56607】Re:特定のシートに独自メニュを組み込む方法 操否 08/6/24(火) 11:53 お礼[未読]
【56608】Re:特定のシートに独自メニュを組み込む方法 操否 08/6/24(火) 14:24 質問[未読]
【56616】Re:特定のシートに独自メニュを組み込む方法 neptune 08/6/24(火) 17:56 発言[未読]
【56626】Re:特定のシートに独自メニュを組み込む方法 操否 08/6/25(水) 13:20 お礼[未読]
【56627】Re:特定のシートに独自メニュを組み込む方法 neptune 08/6/25(水) 13:58 発言[未読]
【56645】Re:特定のシートに独自メニュを組み込む方法 操否 08/6/26(木) 18:24 お礼[未読]
【56598】特定のシートに独自メニュを組み込む方法
質問  操否  - 08/6/23(月) 17:32 -
引用なし
パスワード
   よろしくお願いいたします

特定のシートだけ、独自メニューを組み込みたいと思っています

SheetActivateとSheetDeactivateで行ってみましたが
独自メニューのあるシートを開いた状態で
他のブックを開くと、そのブックに独自メニューが付いてしまいました

そこで、
特定のシートに独自メニュを組み込んだブックを閉じるときに
他のブックに付いた独自メニューを削除してみましたが本末転倒みたいな気がします

ブックを開くとき、独自メニューを組み込まないようにすればいいとは思いますがわかりません

ご教授よろしくお願いします

また、考え方が根本からおかしいような気もしますがどうなんでしょう
よろしくお願いいたします


ThisWorkbookモジュール


Option Explicit


Private Sub Workbook_BeforeClose(Cancel As Boolean)

　　　　
　　　　Dim wb As Workbook
　　　　For Each wb In Workbooks
　　　　　　If wb.Name <> ThisWorkbook.Name Then

　　　　　　　　On Error Resume Next
　　　　　　　　RemoveMenu
　　　　　　　　On Error GoTo 0

　　　　　　End If
　　　　Next

End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)

　　With ActiveSheet
　　　　If .Name <> "操作画面" And .Name <> "登録DT一覧" Then
　　　　　　my_menu
　　　　Else
　　　　　　On Error Resume Next
　　　　　　RemoveMenu
　　　　　　On Error GoTo 0
　　　　End If
　　　　　　
　　End With

End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)

　　With ActiveSheet
　　　　On Error Resume Next
　　　　If .Name <> "操作画面" And .Name <> "登録DT一覧" Then RemoveMenu
　　　　On Error GoTo 0
　　End With

End Sub
【56601】Re:特定のシートに独自メニュを組み込む...
質問  操否  - 08/6/23(月) 19:49 -
引用なし
パスワード
   追記です

特定のシートは、コードで追加しています
で、このシートだけに独自メニューを追加しています
【56602】Re:特定のシートに独自メニュを組み込む...
発言  りん E-MAIL  - 08/6/23(月) 20:26 -
引用なし
パスワード
   操否 さん、こんばんわ。

>特定のシートだけ、独自メニューを組み込みたいと思っています
>他のブックを開くと、そのブックに独自メニューが付いてしまいました

Private Sub Workbook_Deactivate()　で、独自メニューを削除するようにし、
Private Sub Workbook_Activate()　で、該当のシートがアクティブな時にメニューを追加するようにしてみてはどうですか？
【56605】Re:特定のシートに独自メニュを組み込む...
お礼  操否  - 08/6/24(火) 11:34 -
引用なし
パスワード
   ▼りん さん
こんにちは　ありがとうございます

アドバイスから希望の操作かないました

が、
本文をUPしようとすると
ＥＲＲＯＲ：本文に禁止語句が含まれています。
となってしまいます

この辺どちらを見ればよいでしょうか

こちらの掲示板不慣れです
よろしくお願いいたします
【56607】Re:特定のシートに独自メニュを組み込む...
お礼  操否  - 08/6/24(火) 11:53 -
引用なし
パスワード
   >ＥＲＲＯＲ：本文に禁止語句が含まれています。
は、URLが入力禁止になってます。
でした

再掲させて頂きます

▼りん さん
こんにちは　ありがとうございます

なるほどと思ったのですが
実際に試してみると、思ったのと違いました

りんさんはこちらがどんな操作してるか？だと思います
申し訳ありませんでした

アドバイスから下記のようにして希望の操作かないました
ちなみに
別Ｑ　▼【56473】指定シート以外削除　if文ですが 　から
IF文はSelect Case文に置き換えています

動作
元ブックで、特定シート追加で独自メニュが出る
他シートに移ると独自メニューは消える
独自メニュ付き特定シートから新規ブックを開いても独自メニューは付かない


Private Sub Workbook_SheetActivate(ByVal Sh As Object)　　
　　　　Select Case ActiveSheet.Name　　　　
　　　　　　Case "操作画面", "登録DT一覧"　　　　　　
　　　　　　Case Else　　　　　　
　　　　　　　　my_menu　　　　
　　　　End Select
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)　　
　　　　Select Case ActiveSheet.Name　　　　
　　　　　　Case "操作画面", "登録DT一覧"　　　　　　
　　　　　　　　On Error Resume Next
　　　　　　　　RemoveMenu
　　　　　　　　On Error GoTo 0　　　　　　
　　　　　　Case Else　　　　
　　　　End Select
End Sub

Private Sub Workbook_Activate()
　　　　Select Case ActiveSheet.Name　　　　
　　　　　　Case "操作画面", "登録DT一覧"　　　　　　
　　　　　　Case Else　　　　　　
　　　　　　　　my_menu　　　　
　　　　End Select
End Sub

Private Sub Workbook_Deactivate()
　　On Error Resume Next
　　RemoveMenu
　　On Error GoTo 0
End Sub

何かありましたらよろしくお願いいたします
【56608】Re:特定のシートに独自メニュを組み込む...
質問  操否  - 08/6/24(火) 14:24 -
引用なし
パスワード
   不具合ありました
紛らわしいのですが、
特定シート追加で独自メニュが出る
は
"操作画面", "登録DT一覧"以外のシートが追加されたら
です
というわけで
シートが追加される都度
独自メニュ"JOB担当登録一覧表"が登録されてしまいました
で
独自メニュ"JOB担当登録一覧表"が
登録されていたら、登録しない
としたかったのですが、
このコードがわかりませんでした。
アドバイスありましたらよろしくお願いいたします


現状は、上記のコードのうち、下記を修正して
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)　　
　　
　　　　'Select Case ActiveSheet.Name
　　　　
　　　　　　'Case "操作画面", "登録DT一覧"
　　　　　　
　　　　　　　　On Error Resume Next
　　　　　　　　RemoveMenu
　　　　　　　　On Error GoTo 0
　　　　　　
　　　　　　'Case Else
　　　　
　　　　'End Select　　

End Sub
で強制的に、独自メニューがあれば削除することで
見かけ、希望の操作は出来ているように思えますが・・・
自信がありません


また、もう少し、スッキリした記述も可能なような気がしています

何かありましたらよろしくお願いいたします
【56616】Re:特定のシートに独自メニュを組み込む...
発言  neptune  - 08/6/24(火) 17:56 -
引用なし
パスワード
   ▼操否 さん：
>不具合ありました
>紛らわしいのですが、
>特定シート追加で独自メニュが出る
>は
> "操作画面", "登録DT一覧"以外のシートが追加されたら
>です

昔書いた奴ですが、必要なところだけとって使えませんか？
Sub t()
Dim bar As CommandBar
Dim ctrl As CommandBarControl
Dim i As Long, r As Long, col As Long
Dim wksheet As Worksheet

　　Set wksheet = Worksheets("Sheet1")
　　For Each bar In Application.CommandBars
　　　　r = r + 1
　　　　col = 1
　　　　Cells(r, col).Value = "Name : " & bar.Name & "　　 index : " & bar.Index
　　　　i = 0
　　　　For Each ctrl In bar.Controls
　　　　　　wksheet.Cells(r, col + 1).Value = "Caption : " & ctrl.Caption
　　　　　　wksheet.Cells(r, col + 2).Value = "ID : " & ctrl.ID
　　　　　　r = r + 1
　　　　Next
　　Next
　　Set wksheet = Nothing
End Sub

若しくは
on error resume next
Set mnu= mymenu.Controls("メニュー名")
if err.number<>0 then
　　mesgbox "ないよ"
end if
on error goto 0
とかも有りですかね。（確認してません。m(_ _)m)

>独自メニュ"JOB担当登録一覧表"が
>登録されていたら、登録しない
>としたかったのですが、
いちいち登録するのではなく、使用不可にするのでは駄目ですか？
長い間書いた事無いので忘れましたが、メニューで非表示って出来ましたっけ？
出来ればこちらの方が楽チンと思います。
【56626】Re:特定のシートに独自メニュを組み込む...
お礼  操否  - 08/6/25(水) 13:20 -
引用なし
パスワード
   neptune さん　ありがとうございます


>昔書いた奴ですが、必要なところだけとって使えませんか？
メニュー一覧が取得できました
ユーザー登録のメニューも取得できるんですね！

上記と
>若しくは
で、
>>登録されていたら、
の判定が出来ました

Public Sub ggg2()

Dim wksheet As Worksheet
Dim mnu

On Error Resume Next

　　Set wksheet = Worksheets("Sheet1")

　　On Error Resume Next

　　Set mnu = Application.CommandBars("Worksheet Menu Bar").Controls("JOB担当登録一覧表")
　　
　　If Err.Number <> 0 Then
　　　　MsgBox "ないよ"
　　Else
　　　　MsgBox "あるよ"
　　End If
　　On Error GoTo 0

End Sub

>メニューで非表示って出来ましたっけ？
は
Application.CommandBars("Worksheet Menu Bar").Controls("JOB担当登録一覧表").Visible = False
で、出来ました

コードをご提示頂き、希望の操作が適いました
おかげさまで、いろいろ勉強できました　ありがとうございました


皆様、ありがとうございました。
本件はこれで解決です


ちょっと脱線ですが
最近、自宅でvista　office2007を購入しましたが、
アクセス、エクセル共、メニューバー、コマンドバーがわからずお手上げに近いですが

>昔書いた奴ですが、必要なところだけとって使えませんか？
を試したところ、メニュー一覧が取得できました

ユーザーメニュー登録もできましたが、
メニューバーにアドインのタブが追加され
それを押すと
メニューコマンド　て　フレーム？にユーザ登録メニュがありました

アドインタブの追加でなく、ここにユーザ登録メニュを追加することは可能なのでしょうか
2007の操作自体よくわかっていません

簡単にコメント頂けるとうれしいです
よろしくお願いいたします
【56627】Re:特定のシートに独自メニュを組み込む...
発言  neptune  - 08/6/25(水) 13:58 -
引用なし
パスワード
   ▼操否 さん：
こんにちは

あるなしの判定は個人的好みとしてはこんな感じが好き。
避けられるエラーを出すのは嫌いなので。

これも、べた書きなので、確認してません。元は先にUPしたsub t です。
function t() as boolean
色々省略
　　dim flg as boolean
　　flg = false
色々省略
　　For Each bar In Application.CommandBars
　　　　r = r + 1
　　　　col = 1
　　　　if bar.Name = "見つけたい名前" then
　　　　　　flg = true
　　　　　　exit for
　　　　end if
　　Next
　　Set wksheet = Nothing
　　t=flg
End Sub

後、↓のサンプルですが、操否 さんには必要ないと思いますが、
後で見るかもしれない初心者の方の為に書いておくと、
>Public Sub ggg2()
>
>Dim wksheet As Worksheet
>Dim mnu
>
>On Error Resume Next
>
>　　Set wksheet = Worksheets("Sheet1")
>
>　　On Error Resume Next
>
>　　Set mnu = Application.CommandBars("Worksheet Menu Bar").Controls("JOB担当登録一覧表")
>　　
>　　If Err.Number <> 0 Then
もし他人様に使っていただくなら、の話ですが、
これも万一コントロールの無い時のエラー以外が出た時の為に、エラー番号は
限定しておく方が良いですね。慎重すぎると言われるかもしれませんが。
それくらいしておく方が安心できます。

2007持ってないので2007についてはコメントできません。
【56645】Re:特定のシートに独自メニュを組み込む...
お礼  操否  - 08/6/26(木) 18:24 -
引用なし
パスワード
   neptune さん　ありがとうございました


エラー処理については
勉強しなくてはいけないと思っています
いくつかの処理パターンがあるのではという気がして
時折ググッてみたりするのですがいまいち理解しきれていません

コードのご提示ありがとうございました　勉強させていただきます

今回は、
登録先が　Worksheet Menu Bar　で、JOB担当登録一覧表　の決め打ちでいいかなと

普段は、時間が取れないので動けばいいかな程度が多いです　(*o*)＼baki

アドバイスから下記であればエラーに会わなくてすみますね

?t41("JOB担当登録一覧表")

Function t41(tg_menu As String) as boolean

　　Dim bar As CommandBar
　　Dim ctrl As CommandBarControl

　　For Each bar In Application.CommandBars
　　　　
　　　　If bar.Name = "Worksheet Menu Bar" Then

　　　　　　'Debug.Print bar.Name
　　　　　　For Each ctrl In bar.Controls

　　　　　　　　If ctrl.Caption = tg_menu Then
　　　　　　　　　　
　　　　　　　　　　'Debug.Print ctrl.Caption
　　　　　　　　　　 t41 = True
　　　　　　　　　　 Exit Function
　　　　　　　　Else
　　　　　　　　
　　　　　　　　　　t41 = False
　　　　　　　　
　　　　　　　　End If
　　　　　　
　　　　　　Next
　　　　
　　　　End If
　　　　
　　Next

End Function


>後、↓のサンプルですが、操否 さんには必要ないと思いますが、

ご指摘頂きなるほどです
エラー処理の練習のきっかけがつかめたような気がします

Public Sub ggg2()

Dim wksheet As Worksheet
Dim mnu

On Error Resume Next

　　Set wksheet = Worksheets("Sheet1")

　　On Error Resume Next

　　Set mnu = Application.CommandBars("Worksheet Menu Bar").Controls("JOB担当登録一覧表")
　　
　　'Debug.Print Err.Number & " : " & Err.Description
　　'5 : プロシージャの呼び出し、または引数が不正です。
　
　　If Err.Number = 5 Then
　　　　MsgBox "ないよ"
　　Else
　　　　MsgBox "あるよ"
　　End If
　　On Error GoTo 0

End Sub


>2007持ってないので2007についてはコメントできません。
了解です
ありがとうございました
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
4446 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free