| |
すいません。そのマクロでは常に 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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
