Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

61233 / 76732

←次へ　｜　前へ→


	【20122】Re:コンボコックスでシートを切り替える...

Kein - 04/11/29(月) 0:21 -


	引用なし

	パスワード

すいません。そのマクロでは常に Personal.xls のシートしかリストに入りません
でした。全て削除して、以下のマクロに変更して下さい。
使い方も前と異なります。コンボボックスの隣に、ニコちゃんマークのボタンが
追加されています。任意のブックを開いたとき、このボタンを押すことによって
シート名のリストが変更されます。自動更新されませんので、以前に開いていた
ブックのシート名が残っている場合がありますが、存在しないシート名をクリック
すると、警告メッセージが出るようにしてあります。ボタンを押せば新規リストに
更新され、コンボボックスが使えるようになります。

Sub Auto_Open()
　 Dim CB As CommandBar
　 Dim WS As Worksheet
　
　 On Error Resume Next
　 With Application.CommandBars
　　　Set CB = .Item("SheetSelect")
　　　If Err.Number <> 0 Then
　　　　 Set CB = .Add("SheetSelect", msoBarFloating, False, True)
　　　　 With CB.Controls.Add(Type:=msoControlComboBox, Temporary:=True)
　　　　　　.Tag = "GetS"
　　　　　　.Priority = 1
　　　　　　.OnAction = "Ac_Sheet"
　　　　　　.DropDownLines = 10
　　　　　　.Enabled = False
　　　　 End With
　　　　 With CB.Controls.Add(Type:=msoControlButton, Temporary:=True)
　　　　　　.Caption = "シート名取得"
　　　　　　.FaceId = 59
　　　　　　.OnAction = "Get_SheetN"
　　　　 End With
　　　　 Err.Clear
　　　End If
　　　On Error GoTo 0
　　　With .Item("Standard")
　　　　 CB.left = .Width + 1: CB.top = .top
　　　End With
　 End With
　 CB.Visible = True: Set CB = Nothing
End Sub

Sub Auto_Close()
　 With CommandBars("SheetSelect")
　　　If .Visible = True Then .Visible = False
　 End With
　 ThisWorkbook.Save
End Sub

Sub Get_SheetN()
　 Dim WS As Worksheet
　
　 If ActiveWorkbook.Name = ThisWorkbook.Name Then Exit Sub
　 With CommandBars("SheetSelect").Controls(1)
　　　.Enabled = True
　　　If .ListCount > 0 Then .Clear
　　　.AddItem "[シート選択]"
　　　For Each WS In ActiveWorkbook.Worksheets
　　　　 .AddItem WS.Name
　　　Next
　　　.ListIndex = 1
　 End With
End Sub

Sub Ac_Sheet()
　 Dim Cmb As CommandBarControl
　 Dim MyS As String

　 Set Cmb = CommandBars("SheetSelect").Controls(1)
　 With Cmb
　　　If .ListIndex < 2 Then GoTo ELine
　　　MyS = .List(.ListIndex)
　 End With
　 On Error Resume Next
　 With Worksheets(MyS)
　　　If .Visible = False Then .Visible = True
　　　.Activate
　 End With
　 If Err.Number <> 0 Then
　　　MsgBox "アクティブブックが変わっています" & vbLf & _
　　　"ボタンを押してこのブックのシート名をリストに入れて下さい", 48
　　　Err.Clear: Cmd.Clear: Cmd.Enabled = False
　 Else
　　　Cmb.ListIndex = 1
　 End If
ELine:
　 Set Cmb = Nothing
End Sub

0 hits

▼

【20090】コンボコックスでシートを切り替えるには... もぐすたー 04/11/27(土) 22:40