Excel VBA質問箱 IV

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

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


10738 / 13644 ツリー ←次へ | 前へ→

【20090】コンボコックスでシートを切り替えるには... もぐすたー 04/11/27(土) 22:40 質問[未読]
【20091】Re:コンボコックスでシートを切り替えるに... Kein 04/11/27(土) 23:44 回答[未読]
【20105】Re:コンボコックスでシートを切り替える... もぐすたー 04/11/28(日) 14:39 質問[未読]
【20107】Re:コンボコックスでシートを切り替える... Hirofumi 04/11/28(日) 15:38 回答[未読]
【20110】Re:コンボコックスでシートを切り替える... もぐすたー 04/11/28(日) 17:47 お礼[未読]
【20108】Re:コンボコックスでシートを切り替える... Kein 04/11/28(日) 15:40 回答[未読]
【20111】Re:コンボコックスでシートを切り替える... もぐすたー 04/11/28(日) 18:02 質問[未読]
【20115】Re:コンボコックスでシートを切り替える... Kein 04/11/28(日) 20:26 回答[未読]
【20121】Re:コンボコックスでシートを切り替える... もぐすたー 04/11/28(日) 22:33 質問[未読]
【20122】Re:コンボコックスでシートを切り替える... Kein 04/11/29(月) 0:21 回答[未読]
【20154】Re:コンボコックスでシートを切り替える... もぐすたー 04/11/29(月) 21:04 お礼[未読]

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

引用なし
パスワード
   はじめまして。

コンボボックスを使用してシートを切り替える方法を探しています。

具体的には、シート1を目次シート(コンボボックスのシート)とし、その他の約60シートをコンボボックスで選択したシートに切り替えるというものです。

よろしくお願いします。

【20091】Re:コンボコックスでシートを切り替える...
回答  Kein  - 04/11/27(土) 23:44 -

引用なし
パスワード
   >選択したシートに切り替える
例えば末尾のシートをアクティブにした場合、次に10番目のシートをアクティブに
したいと思ったらいちいち先頭のメニューシートを開くのですか ? そんな面倒な
ことをするようでは、マクロを作る意味がありませんよね。私なら
「現在アクティブになっているシート(どれでもOK)の A列で、次に開きたいシートの
インデックスと同じ行のセルをダブルクリックして、そのシートを開く」という
やり方にします。コードは以下のようになります。ThisWorkbookモジュールに
入れてみて下さい。

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, _
ByVal Target As Range, Cancel As Boolean)
  Dim SCnt As Integer, GetS As Long

  If Target.Column > 1 Then Exit Sub
  Cancel = True
  SCnt = Worksheets.Count
  GetS = Target.Row
  If GetS > SCnt Or GetS = Sh.Index Then Exit Sub
  Worksheets(GetS).Activate
End Sub

【20105】Re:コンボコックスでシートを切り替える...
質問  もぐすたー  - 04/11/28(日) 14:39 -

引用なし
パスワード
   Kein 様 早速のご教示ありがとうございます。

Kein様のとおりで確かに思い通りに動作するのですが、他人向けのファイルとしては分らない操作のようです。(個人のみで利用するファイルなら便利だと思います。)

今回作成するファイルの利用目的を説明しておりませんでしたので、追加説明させていただいた上で改めてご教示いただければと思います。

今回作成しようとしているデータはある県内の市町村毎の表で、市町村ごとに1シートとなっております。(シート名も市町村名に変更)
そして、このデータはHPに公開し、誰でも簡単にシートを切り替えて利用できるようにするものです。
最初は全てハイパーリンクによるシート切り替えを考えたのですが、HPで表示する都合上、メニューシートに全ての市町村一覧を表示するにはレイアウトが思うように決まらなかったため、コンボボックスにより市町村を選択すると目的のシートに異動する方法をと思っていたところです。(各シートには、メニューシートへ戻るハイパーリンクを設定するつもりでした。)

もちろん、私の質問の方法によらなくても、初めてファイルを開いた人が迷い無くシートを切り替えられる方法であれば、コンボボックスでなくても構いません。

申し訳ありませんが、別の手段で再度ご教示いただければと思います。

【20107】Re:コンボコックスでシートを切り替える...
回答  Hirofumi  - 04/11/28(日) 15:38 -

引用なし
パスワード
   ThesWorkbookのコードモジュールに以下を記述

Option Explicit

Private Sub Workbook_Open()

  With Worksheets("Sheet1")
    .OLEObjects("ComboBox1").Object.List = GetSheetNames(.Name)
  End With

End Sub

Private Function GetSheetNames(strExclusion As String) As Variant

  Dim i As Long
  Dim j As Long
  Dim vntData() As Variant
  
  With Sheets
    For i = 1 To .Count
      If .Item(i).Name <> strExclusion Then
        ReDim Preserve vntData(j)
        vntData(j) = .Item(i).Name
        j = j + 1
      End If
    Next i
  End With
  
  GetSheetNames = Application.Transpose(vntData)
  
End Function

Sheet1のコードモジュールに以下を記述

Option Explicit

Private Sub ComboBox1_Change()

  With ComboBox1
    If .ListIndex <> -1 Then
      Sheets(.Value).Activate
    End If
  End With
  
End Sub

【20108】Re:コンボコックスでシートを切り替える...
回答  Kein  - 04/11/28(日) 15:40 -

引用なし
パスワード
   ではブックを開いたときに、標準ツールバーにコンボボックスを挿入するように
したらどうでしょーか ? 以下のマクロを全て標準モジュールに入れ、いったん
ブックを閉じて再度開いてみて下さい。

Sub Auto_Open()
  Dim WS As Worksheet
 
  With Application.CommandBars("Standard") _
  .Controls.Add(Type:=msoControlComboBox, Temporary:=True)
   .AddItem "[シート選択]"
   For Each WS In Worksheets
     .AddItem WS.Name
   Next
   .Tag = "GetS"
   .Priority = 1
   .OnAction = "Ac_Sheet"
   .DropDownLines = 10
   .ListIndex = 1
  End With
End Sub

Sub Auto_Close()
  Dim Cmb As CommandBarControl
 
  For Each Cmb In CommandBars("Standard").Controls
   If Cmb.Tag = "GetS" Then Cmb.Delete: Exit For
  Next
  ThisWorkbook.Save
End Sub

Sub Ac_Sheet()
  Dim Cmb As CommandBarControl
  Dim MyS As String
 
  For Each Cmb In CommandBars("Standard").Controls
   If Cmb.Tag = "GetS" Then Exit For
  Next
  If Cmb Is Nothing Then Exit Sub
  With Cmb
   If .ListIndex < 2 Then GoTo ELine
   MyS = .List(.ListIndex)
  End With
  With Worksheets(MyS)
   If .Visible = False Then .Visible = True
   .Activate
  End With
  Cmb.ListIndex = 1
ELine:
  Set Cmb = Nothing
End Sub

【20110】Re:コンボコックスでシートを切り替える...
お礼  もぐすたー  - 04/11/28(日) 17:47 -

引用なし
パスワード
   Hirofumi 様

私のイメージどおりの操作方法でした。
早速明日にでもHP公開テストしてみます。
ありがとうございました。

【20111】Re:コンボコックスでシートを切り替える...
質問  もぐすたー  - 04/11/28(日) 18:02 -

引用なし
パスワード
   Kein 様

またまた斬新なご提案ありがとうございます。
2件のご教示がありましたので、早速明日にでもそれぞれHP公開テストをしてみます。

ところでこの機能ですが、どこか別の場所に記述すれば、エクセルの標準機能としても使用できるものなのでしょうか?
(ファイル毎に記述しなくても、エクセルを立ち上げると常に機能するように。)

それと、ユーザー設定で作成したツールバーに組み込む場合は、どこをどのように変えれば対応できるのでしょうか?

【20115】Re:コンボコックスでシートを切り替える...
回答  Kein  - 04/11/28(日) 20:26 -

引用なし
パスワード
   >エクセルの標準機能としても使用
ということなら、アドインにする方法もありますが、配布を目的とせず
>ファイル毎に記述しなくても、エクセルを立ち上げると常に機能
ということをするだけなら、Personal.xls を使います。Personal.xls の作り方
などは↓の「マクロの使い方 5 」を参考にして下さい。
http://park11.wakwak.com/~miko/Excel_Note/14-01_macro.htm#14-01-01
で、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)
      .AddItem "[シート選択]"
      For Each WS In Worksheets
        .AddItem WS.Name
      Next
      .Tag = "GetS"
      .Priority = 1
      .OnAction = "Ac_Sheet"
      .DropDownLines = 10
      .ListIndex = 1
     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 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
  With Worksheets(MyS)
   If .Visible = False Then .Visible = True
   .Activate
  End With
  Cmb.ListIndex = 1
ELine:
  Set Cmb = Nothing
End Sub

【20121】Re:コンボコックスでシートを切り替える...
質問  もぐすたー  - 04/11/28(日) 22:33 -

引用なし
パスワード
   Kein 様

>Personal.xls が出来たら、その標準モジュールにマクロを入れて下さい。

上記のとおりやってみたところ、エクセルを起動するとSheetSelectが表示されるようになりましたが、シートの選択ができません。(標準設定で起動時にはシートが3枚ありますが、[シート選択]の下にシートの名前が出てきません。)

原因はなんでしょうか?

【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

【20154】Re:コンボコックスでシートを切り替える...
お礼  もぐすたー  - 04/11/29(月) 21:04 -

引用なし
パスワード
   Kein 様

本題とはそれてしまい恐縮でしたが、「SheetSelect」が無事設置されました。
シート数の多いファイルを扱う事が多い為、今後重宝しそうです。

ありがとうございました。

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