| |
いつもりんさんの回答を見ててホント凄いなと思っています。
今回も感謝！です。ありがとうございました〜m(__)m。
>
>>考えたのがシート2〜シート6で作業しているときにツールバーにボタンを
>>貼り付けてそれをクリックしたらシート1がアクティブになる様なことを
>>すれば良いと思うのですが、そのやり方を教えていただけ無いでしょうか。
>
>新しいバーを作って、シート間を移動するようにしました。
>下のコードを全てThisworkbookに書いて、一旦保存して終了してから開いてみてください。
>'ここから////////////////////////////////////////////////
>Const cbn As String = "■シート移動■" 'コマンドバーの名前
>
>Private Sub Workbook_Activate()
> 'このブックがアクティブなときは使用可
> On Error Resume Next
> Application.CommandBars(cbn).Enabled = True
> On Error GoTo 0
>End Sub
>
>Private Sub Workbook_BeforeClose(Cancel As Boolean)
> 'ブックを閉じるとき削除
> On Error Resume Next
> Application.CommandBars(cbn).Delete
> On Error GoTo 0
>End Sub
>
>Private Sub Workbook_Deactivate()
> '違うブックがアクティブなときは使用不可
> On Error Resume Next
> Application.CommandBars(cbn).Enabled = False
> On Error GoTo 0
>End Sub
>
>Private Sub Workbook_Open()
> Dim cb1 As CommandBar, cbb As CommandBarButton, ws As Worksheet, Idx%
> '既にあれば削除
> On Error Resume Next
> Application.CommandBars(cbn).Delete
> On Error GoTo 0
> '
> Idx% = 0
> Set cb1 = Application.CommandBars.Add(Name:=cbn)
> For Each ws In ThisWorkbook.Worksheets
> Idx% = Idx% + 1
> Set cbb = cb1.Controls.Add(Type:=msoControlButton)
> With cbb
> .Style = msoButtonCaption
> .Caption = ws.Name
> .BeginGroup = True
> .OnAction = ThisWorkbook.Name & "!Thisworkbook.ShtSel"
> End With
> Next
> '現在表示しているシートのコマンドを無効
> CBC_Edit ActiveSheet.Name, False
> cb1.Visible = True
> Set cb1 = Nothing: Set cbb = Nothing
>End Sub
>
>Private Sub Workbook_SheetActivate(ByVal Sh As Object)
> CBC_Edit Sh.Name, False
>End Sub
>
>Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
> CBC_Edit Sh.Name, True
>End Sub
>
>Sub CBC_Edit(wsn As String, tf As Boolean)
> 'コマンドの使用可／不可の切替
> On Error Resume Next
> Application.CommandBars(cbn).Controls(wsn).Enabled = tf
> On Error GoTo 0
>End Sub
>
>Private Sub ShtSel()
> 'コマンドクリック時の実働部分
> Dim cbc As CommandBarControl
> Set cbc = Application.CommandBars.ActionControl
> If Not cbc Is Nothing Then _
> ThisWorkbook.Worksheets(cbc.Caption).Activate _
> Else _
> MsgBox "直接実行しても何もおきません", vbInformation
>End Sub
>
>'ここまで////////////////////////////////////////////////
>
>こんな感じです。
|
|
NH
- 03/4/6(日) 20:46 -
