午後わてんのブログ

ベランダ菜園とWindows用アプリ作成(WPFとC#)

エクセル2007、右クリックメニューからシート一覧を表示してシートを選択

エクセルExcel2007 #Windows
-----------------2014/10/28追記ここから--------------
この記事のマクロを修正した記事
エクセル2007、右クリックメニューにシート一覧ボタンを作成するマクロ修正版 - 午後わてんのブログ - Yahoo!ブログ
 
-----------------2014/10/28追記ここまで-----------------
 

エクセル2007、右クリックメニューからシートを選択その2

 
昨日の続きでいじっていたら良くなった
見た目は昨日とほとんど同じ
違うのはボタンの名前をブックの名前＋"シート一覧"にしたところ

f:id:gogowaten:20191014162455p:plain

 

f:id:gogowaten:20191014162512p:plain

Sheet1からSheet3までのとき
ここから新しくシートを挿入したときやシートを削除、
シート名を変更した場合にボタンが対応するようにした
 
 

f:id:gogowaten:20191014162531p:plain

↑Sheet2をシート2に名前変更、Sheet3を削除してから右クリック
 
そこからシートを3枚挿入してから右クリック↓

f:id:gogowaten:20191014162549p:plain

 

f:id:gogowaten:20191014162607p:plain

右クリックしたブックとは別のシートを選択した時も表示できるようにした
右クリックした場所はBook7という名前のブックで選択したシートは
MHP3という名前のブックのスキルという名前のシート
 
結果は↓

f:id:gogowaten:20191014162627p:plain

MHP3のスキルが表示された
MHP3は複数のウィンドウを開いていてウィンドウの名前が
ブックのファイル名の後ろに:と数字になっている
他のブックから選択されたシートが有るブックが複数ウィンドウだった場合は
数字が1のウィンドウになるのは仕様
 
書いた場所は昨日と同じで個人用マクロブックのPERSONAL.XLSBの
標準モジュール
右クリックメニューにボタンを追加したりするマクロがこれで

f:id:gogowaten:20191014162644p:plain

 
Public Sub 右クリックメニューにシート一覧作成3() '2014/05/30

    Dim cb As CommandBar
    Dim b1 As CommandBarPopup
    Dim b2 As CommandBarButton
    Dim ws As Sheets
    Dim Wbn As String, b1Name As String
    Dim c As CommandBarControl, b As CommandBarControl
    
    Set ws = ActiveWorkbook.Sheets
    Set cb = Application.CommandBars(36) '右クリックメニュー
    Wbn = ActiveWorkbook.Name
    b1Name = Wbn & "シート一覧"
    
'右クリックメニューにシート一覧ボタンがあればその中のボタンを全部消去して新しくボタンを作りなおす
    For Each c In cb.Controls
        If c.Caption = b1Name Then
            Set b1 = c
            For Each b In c.Controls '全部消去
                b.Delete
            Next b
            
            '作り直し
            With b1
                .Caption = b1Name 'アクティブブック名 & "シート一覧"
                .OnAction = "右クリックメニューにシート一覧作成3"
                
                For i = 1 To ws.Count
                    Set b2 = .Controls.Add(Type:=msoControlButton, temporary:=True, parameter:=Wbn)
                    b2.Caption = ws(i).Name
                    b2.OnAction = "シート選択"
                Next i
            End With
            Exit Sub '全て終了
            
        End If
    Next c
    
'シート一覧ボタンがなかった場合、新たに作成
    Set b1 = cb.Controls.Add(Type:=msoControlPopup, temporary:=True, before:=1) ', parameter:=wbn)
    
    With b1
        .Caption = b1Name 'アクティブブック名 & "シート一覧"
        .OnAction = "右クリックメニューにシート一覧作成3"
        
        For i = 1 To ws.Count
            Set b2 = .Controls.Add(Type:=msoControlButton, temporary:=True, parameter:=Wbn)
            b2.Caption = ws(i).Name
            b2.OnAction = "シート選択"
        Next i
    End With
    
End Sub
 
どのボタンが押されたか判定してからシートを表示するマクロがこれ
これも書いた場所は同じPERSONAL.XLSBの標準モジュール
 

f:id:gogowaten:20191014162711p:plain

画像だと余計なコメントがいっぱいなので直したのが↓
 
Public Sub シート選択() '2014/05/30
'
    On Error Resume Next
    Dim AwCap As String, bName As String, aName As String
    Dim l As Long
    bName = Application.CommandBars.ActionControl.parameter '表示したいシートのブックの名前
    AwCap = ActiveWindow.Caption
    
    '同じブックで複数のウィンドウが開かれている場合はウィンドウ名に「:」が付いているのが目印になる
    l = InStr(ActiveWindow.Caption, ":")
    
    If l <> 0 Then
        aName = Left(AwCap, l - 1) '右クリックしたシートのブックの名前
    End If
    
    '目的のシートを表示する
    If bName <> aName Or l = 0 Then
        '表示したいシートとクリックしたシートのブックが違うor複数ウィンドウじゃない時
        Workbooks(bName).Activate
        ActiveWorkbook.Sheets(Application.CommandBars.ActionControl.Caption).Activate
    Else
        '表示したいシートとクリックしたシートのブックが同じで複数ウィンドウの時
        Windows(AwCap).Activate
        ActiveWorkbook.Sheets(Application.CommandBars.ActionControl.Caption).Activate
    End If

End Sub
 
 
うーん、できたなあ、目的のものができて満足
 
 
参照した所