Excel VBA質問箱 IV

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

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


13575 / 13646 ツリー ←次へ | 前へ→

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

【4772】ボタンの追加について
質問  NH  - 03/4/5(土) 18:23 -

引用なし
パスワード
   いつもお世話になっています。また一つお知恵をかりたくなりました。
シート1〜シート6まであってシート2〜シート6までで作業していてそ
の終了後シート1へジャンプするようなことをしたいのです。んで、
考えたのがシート2〜シート6で作業しているときにツールバーにボタンを
貼り付けてそれをクリックしたらシート1がアクティブになる様なことを
すれば良いと思うのですが、そのやり方を教えていただけ無いでしょうか。

【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

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

こんな感じです。

【4775】素晴しいです!
お礼  NH  - 03/4/6(日) 20:46 -

引用なし
パスワード
   いつもりんさんの回答を見ててホント凄いなと思っています。
今回も感謝!です。ありがとうございました〜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
>
>'ここまで////////////////////////////////////////////////
>
>こんな感じです。

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