Excel VBA質問箱 IV

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

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


76380 / 76732 ←次へ | 前へ→

【4774】Re:ボタンの追加について
回答  りん E-MAIL  - 03/4/6(日) 8:05 -

引用なし
パスワード
   NH さん、おはようございます。

>考えたのがシート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

'ここまで////////////////////////////////////////////////

こんな感じです。

0 hits

【4772】ボタンの追加について NH 03/4/5(土) 18:23 質問
【4774】Re:ボタンの追加について りん 03/4/6(日) 8:05 回答
【4775】素晴しいです! NH 03/4/6(日) 20:46 お礼

76380 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free