Excel VBA質問箱 IV

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

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


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

【29119】オプションボタン ハッチ 05/9/25(日) 13:48 質問[未読]
【29124】Re:オプションボタン りん 05/9/25(日) 18:44 回答[未読]
【29158】Re:オプションボタン ハッチ 05/9/26(月) 21:23 お礼[未読]
【29165】Re:オプションボタン りん 05/9/27(火) 8:17 発言[未読]
【29226】Re:オプションボタン ハッチ 05/9/28(水) 1:27 お礼[未読]
【29325】Re:オプションボタン Komo 05/9/30(金) 19:30 質問[未読]
【29368】Re:オプションボタン Jaka 05/10/3(月) 15:47 回答[未読]
【29433】Re:オプションボタン Komo 05/10/4(火) 20:21 質問[未読]
【29446】Re:オプションボタン Jaka 05/10/5(水) 11:10 発言[未読]
【29456】Re:オプションボタン Komo 05/10/5(水) 19:54 質問[未読]
【29492】Re:オプションボタン Jaka 05/10/6(木) 12:51 回答[未読]
【29518】Re:オプションボタン Komo 05/10/6(木) 20:49 質問[未読]
【29524】Re:オプションボタン ハッチ 05/10/6(木) 21:44 質問[未読]
【29557】Re:オプションボタン Jaka 05/10/7(金) 15:16 回答[未読]
【29566】Re:オプションボタン ハッチ 05/10/7(金) 19:53 お礼[未読]
【29572】Re:オプションボタン Komo 05/10/8(土) 0:04 質問[未読]
【29613】Re:オプションボタン りん 05/10/9(日) 12:35 発言[未読]
【29666】勘違いしてました。(勘違いしたまま、開い... Jaka 05/10/11(火) 10:17 発言[未読]
【45328】今ごろですが。 Jaka 06/12/19(火) 16:29 発言[未読]

【29119】オプションボタン
質問  ハッチ  - 05/9/25(日) 13:48 -

引用なし
パスワード
   はじめまして。初心者です。
すみませんが、マクロをどう組んだらいいのかがわからないのでどなたか教えてください。

オプションボタンでA,B,C,D,Eの5人の担当者のボタンを作りました。(ワークシートに直接作ってあります。)
もしAを選んで、"表示する"ボタンを押すとAの日程シートに移動するというのを作りたいと考えています。
ファイルは"MENU.xls"と"日程シート.xls"2つあります。

宜しくお願いします。

【29124】Re:オプションボタン
回答  りん E-MAIL  - 05/9/25(日) 18:44 -

引用なし
パスワード
   ハッチ さん、こんばんわ。

>すみませんが、マクロをどう組んだらいいのかがわからないのでどなたか教えてください。
>
>オプションボタンでA,B,C,D,Eの5人の担当者のボタンを作りました。(ワークシートに直接作ってあります。)
>もしAを選んで、"表示する"ボタンを押すとAの日程シートに移動するというのを作りたいと考えています。
>ファイルは"MENU.xls"と"日程シート.xls"2つあります。

オプションボタンがコントロールツールボックスから組み込まれたものだとして。

Private Sub CommandButton1_Click()
  Dim obj1 As OLEObject, wsn As String, wb As Workbook
  For Each obj1 In ActiveSheet.OLEObjects
   If TypeName(obj1.Object) = "OptionButton" Then
     With obj1.Object
      If .Value = True Then
        wsn = .Caption: Exit For
      End If
     End With
    
   End If
  Next
  '既に開かれているかチェック
  For Each wb In Application.Workbooks
   If wb.Name = "日程シート.xls" Then
     wb.Activate
     Exit For
   End If
  Next
  If wb Is Nothing Then
   'MENUブックと同じフォルダにあるとして
   Set wb = Workbooks.Open(ThisWorkbook.Path & "\日程シート.xls")
  End If
  '対応するシート名が無いとエラーになるので注意
  wb.Worksheets(wsn).Activate
  '
  Set wb = Nothing: Set obj1 = Nothing
End Sub

こんな感じです。
 フォームのツールバーから貼られたものだとどういう挙動になるのかわかりませんが。
 オプションボタンのどれがTrueになっているのかを格納するセルまたはラベルやテキストボックス(非表示でよい)を作っておくと、チェックの部分を省くことができるので楽になりますよ。

【29158】Re:オプションボタン
お礼  ハッチ  - 05/9/26(月) 21:23 -

引用なし
パスワード
   返事が遅くなりすみません。
りんさん、教えてくださって本当にありがとうございます。
やってみたんですが、私ではわからないところがありました。
すみませんが、また教えていただけますか?

>  '対応するシート名が無いとエラーになるので注意
>  wb.Worksheets(wsn).Activate

この部分で対応するシート名とは、オプションボタンの名前を
A,B,C,D,Eと作ってあって、日程シート.xlsの中にも同じように
A,B,C,D,Eとそれぞれのシートがあればいいという解釈をしたんですが、
あっていますでしょうか?

宜しくお願いします。

【29165】Re:オプションボタン
発言  りん E-MAIL  - 05/9/27(火) 8:17 -

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

>やってみたんですが、私ではわからないところがありました。
そのままペーストすると動くはずですが。

>>  '対応するシート名が無いとエラーになるので注意
>>  wb.Worksheets(wsn).Activate
>
>この部分で対応するシート名とは、オプションボタンの名前を
>A,B,C,D,Eと作ってあって、日程シート.xlsの中にも同じように
>A,B,C,D,Eとそれぞれのシートがあればいいという解釈をしたんですが、
>あっていますでしょうか?
 あってます。
 オプションボタンのCaptionと日程シートのワークシート名がそれぞれ同じモノ(A,B,C,D,E)となっているのが前提になっています。

【29226】Re:オプションボタン
お礼  ハッチ  - 05/9/28(水) 1:27 -

引用なし
パスワード
   りんさん、お返事ありがとうございます。

動かなかったので、明日もうちょっと色々いじってみます。
また、わからないことがありましたらアドバイスお願いします。
解決できましたら、また投稿しますね!

【29325】Re:オプションボタン
質問  Komo  - 05/9/30(金) 19:30 -

引用なし
パスワード
   ▼りん さん:

今晩は。
実はこのマクロを見させていただいていて、このようなマクロが欲しいと
思っていました。

早速実行させていただきましたが・・・
wb.Worksheets(wsn).Activate
のところでエラーが出ます。wsnのところにシート名が入ってきません。
""の状態で、エラーが出ます。

色々とテストしてみましたが、良い案が出てきません。
(勿論シート名とオプションボタン名は同じ名前にしていますが・・・)
何か良い方法がありましたら、よろしくお願いします。

>
>Private Sub CommandButton1_Click()
>  Dim obj1 As OLEObject, wsn As String, wb As Workbook
>  For Each obj1 In ActiveSheet.OLEObjects
>   If TypeName(obj1.Object) = "OptionButton" Then
>     With obj1.Object
>      If .Value = True Then
>        wsn = .Caption: Exit For
>      End If
>     End With
>    
>   End If
>  Next
>  '既に開かれているかチェック
>  For Each wb In Application.Workbooks
>   If wb.Name = "日程シート.xls" Then
>     wb.Activate
>     Exit For
>   End If
>  Next
>  If wb Is Nothing Then
>   'MENUブックと同じフォルダにあるとして
>   Set wb = Workbooks.Open(ThisWorkbook.Path & "\日程シート.xls")
>  End If
>  '対応するシート名が無いとエラーになるので注意
>  wb.Worksheets(wsn).Activate
>  '
>  Set wb = Nothing: Set obj1 = Nothing
>End Sub
>
>こんな感じです。
> フォームのツールバーから貼られたものだとどういう挙動になるのかわかりませんが。
> オプションボタンのどれがTrueになっているのかを格納するセルまたはラベルやテキストボックス(非表示でよい)を作っておくと、チェックの部分を省くことができるので楽になりますよ。

【29368】Re:オプションボタン
回答  Jaka  - 05/10/3(月) 15:47 -

引用なし
パスワード
   こんにちは。
部分的にしか見てないけれど...。
こうしたらどうでしょうか?

>  '対応するシート名が無いとエラーになるので注意
>  wb.Worksheets(wsn).Activate
   ↓
  Dim WBK As Worksheet, Flg As Boolean
  For Each WBK In wb.Worksheets
    If WBK.Name = wsn Then
      Flg = True
      Exit For
    End If
  Next
  If Flg = True Then
    wb.Worksheets(wsn).Activate
  Else
    msgbox wsn& "シートがありません。"
  End If

【29433】Re:オプションボタン
質問  Komo  - 05/10/4(火) 20:21 -

引用なし
パスワード
   ▼Jaka さん:
>こんにちは。
>部分的にしか見てないけれど...。
>こうしたらどうでしょうか?
>
>>  '対応するシート名が無いとエラーになるので注意
>>  wb.Worksheets(wsn).Activate
>   ↓
>  Dim WBK As Worksheet, Flg As Boolean
>  For Each WBK In wb.Worksheets
>    If WBK.Name = wsn Then
>      Flg = True
>      Exit For
>    End If
>  Next
>  If Flg = True Then
>    wb.Worksheets(wsn).Activate
>  Else
>    msgbox wsn& "シートがありません。"
>  End If

やっぱり、ブックまでは開けますが、指定したシートまで
行きません。そして、「シートがありません。」が表示されます。
optionボタンのCaptionとシート名との関連が切れているような
感じがします。
もう少し調べて見ますが、また良いアイディアが有りましたら
よろしくお願いします。

【29446】Re:オプションボタン
発言  Jaka  - 05/10/5(水) 11:10 -

引用なし
パスワード
   >msgbox wsn& "シートがありません。"
変数と"&"がくっついちゃったけど、離しておいてください。
くっついたままだと、単独の変数名になっちゃいます。
↓解りやすいように"-"で囲みました。
msgbox "-" & wsn & "-" & "シートがありません。"

シート名関係で1番多いトラブルが、コードに記述したシート名と実際のシート名が違う事です。
質問者側は、見た目で判断して「同じです。」って何度も返答した割に実際は違っていたパターンを良く見ます。
半角スペースなどが混じっていたりとかが多いようです。
optionボタンのCaptionとシート名が違っているって事は無いでしょうか?

【29456】Re:オプションボタン
質問  Komo  - 05/10/5(水) 19:54 -

引用なし
パスワード
   ▼Jaka さん:

アドバイスありがとうございます。

>シート名関係で1番多いトラブルが、コードに記述したシート名と実際のシート名が違う事です。
>質問者側は、見た目で判断して「同じです。」って何度も返答した割に実際は違っていたパターンを良く見ます。
>半角スペースなどが混じっていたりとかが多いようです。
>optionボタンのCaptionとシート名が違っているって事は無いでしょうか?

色々とシート名とCaptionをチェックし、変更して試しましたが・・・
シートの名前に繋がりません。
やっぱりwsnが空白「""」になっており、変数の役割を果たしていない
ように見えます。
また、何かお気づきの点が有りましたらアドバイスお願いします。

【29492】Re:オプションボタン
回答  Jaka  - 05/10/6(木) 12:51 -

引用なし
パスワード
   ▼Komo さん:
>シートの名前に繋がりません。
>やっぱりwsnが空白「""」になっており、変数の役割を果たしていない
>ように見えます。
えっと、こちら側から状態が見えないので、確認用。
これ実行すると、どんな結果になりますか?

Sub dnmdmm()
  Dim obj1 As OLEObject, wsn As String, wb As Workbook
  Dim Flg As Boolean
  For Each obj1 In ActiveSheet.OLEObjects
   If TypeName(obj1.Object) = "OptionButton" Then
     Ct = Ct + 1
     With obj1.Object
      If .Value = True Then
        wsn = .Caption
        Flg = True
        Exit For
      End If
     End With
   End If
  Next
  If Ct = 0 Then
   MsgBox "オプションボタンが1個も有りません。"
  ElseIf Flg = False Then
   MsgBox "オプションボタンにチェックが入ってません。"
  Else
   MsgBox "オプションボタン-" & wsn & "-シートが選択されました。"
  End If
End Sub

【29518】Re:オプションボタン
質問  Komo  - 05/10/6(木) 20:49 -

引用なし
パスワード
   ▼Jaka さん:

色々とご配慮ありがとうございます。

>えっと、こちら側から状態が見えないので、確認用。
>これ実行すると、どんな結果になりますか?
>
>Sub dnmdmm()
>  Dim obj1 As OLEObject, wsn As String, wb As Workbook
>  Dim Flg As Boolean
>  For Each obj1 In ActiveSheet.OLEObjects
>   If TypeName(obj1.Object) = "OptionButton" Then
>     Ct = Ct + 1
>     With obj1.Object
>      If .Value = True Then
>        wsn = .Caption
>        Flg = True
>        Exit For
>      End If
>     End With
>   End If
>  Next
>  If Ct = 0 Then
>   MsgBox "オプションボタンが1個も有りません。"
>  ElseIf Flg = False Then
>   MsgBox "オプションボタンにチェックが入ってません。"
>  Else
>   MsgBox "オプションボタン-" & wsn & "-シートが選択されました。"
>  End If
>End Sub

また大変ご迷惑をかけています。
標準のモジュールに貼り付けるのでしょうか?
MsgBox"オプションボタンが1個もありません。"が出ます。
上記コードではオプションボタンを呼び出すのでしょうか?
貼り付ける場所が間違っているのでしょうか?


フォームにオプションボタン1〜5を(「あ、い、う、え、お」)として、日程シートの
シート名に「あ、い、う、え、お」として、コマンドボタン( CommandButton1_Click)で検索するようにしています。ブックは共にフォルダーに入れています。
この辺がおかしいのでしょうか?
でも、wsnに例えば「あ」と入れると・・・シートの「あ」が開けます。


余りにも幼稚な質問ばかりでご迷惑をかけていることと思います。
でも、興味があったこと、それと
一番最初に質問された方から「出来ました」というリアクションが無かったので
私もしてみると、上手く行かなかったので・・・が、質問をしたきっかけに
なっています。

大変ご面倒をかけているかと思いますが、以上が私から伝えられるレベルです。
よろしくお願いします。

【29524】Re:オプションボタン
質問  ハッチ  - 05/10/6(木) 21:44 -

引用なし
パスワード
   ▼Komo さん:
▼Jaka さん:

こんばんわ。
私も解決させたいので、本などで参考になりそうなものをさがしているのですが
オプションボタンの例は少なく未だに解決できていません。。。

まず、りんさんに教えていただいた内容の理解からしていこうと思い
調べてみました。
それで、私はユーザーフォームではなくワークシートにボタンを貼り付けて
いたので下記のコードをかえたら動くのでは?と思い

 変更前  If TypeName(obj1.Object) = "OptionButton" Then
 変更後  If obj1.progID = "Forms.checkbox.1" Then

 に変えて実行してみたんですが結果は変更前と同じで
   '9':インデックスが有効範囲にありません。
 というエラーになりました。
 オプションボタンの名前とシート名に違いがないかを確認しましたが
 違うところはありませんでした。

Jakaさんの確認用を実行してみたところ、Komoさんと同じく
  "オプションボタンが1個も有りません。"
という結果になっています。

どうしてもわからないので、教えていただければと思います。
宜しくお願いします。
      

【29557】Re:オプションボタン
回答  Jaka  - 05/10/7(金) 15:16 -

引用なし
パスワード
   こんにちは。

▼Komo さん:
>フォームにオプションボタン1〜5を(「あ、い、う、え、お」)として、日程シートの
>シート名に「あ、い、う、え、お」として、コマンドボタン( CommandButton1_Click)で検索するようにしています。ブックは共にフォルダーに入れています。

▼ハッチ さん:
>Jakaさんの確認用を実行してみたところ、Komoさんと同じく
>   "オプションボタンが1個も有りません。"
>という結果になっています。

たぶん、簡単な間違いだと思うんですが、シート上に
表示 → ツールバー → コントロールツールボックス(アクティブXコントロール)
のOptionButtonを使っていますか?

また、私の確認用コードは標準モジュールで良いです。
りんさんのコードで、Private Sub CommandButton1_Click()の方は、
シートのCommandButtonでも、ユーザーフォーム上のCommandButtonのどちらでからでも動きました。
また、実行時にOptionButtonが設置されているシートが、アクティブになっていますか?

今一歩、どういった状態で使用しているのか、OptionButtonの種類等が解らないので、リストボックスを使った物を作ってみました。

シート上に、アクティブXコントロールの「ListBox」1つ。
リスト作成用、シート選択用にアクティブXコントロールの「CommandButton」2つ。
が、"Sheet1"にあるとして、
下記コードは、ボタン等があるSheet1のシートモジュールに。

*************
Const 対象ブック名 As String = "Book1" '←対象ブック名に変更してください。

'シートリスト作成
Private Sub CommandButton1_Click()
  Dim Wb As Workbook, Sh As Worksheet
  For Each Wb In Workbooks
    If Wb.Name = 対象ブック名 Then
     With ThisWorkbook.Worksheets("Sheet1").OLEObjects("ListBox1").Object
       .Clear
       For Each Sh In Wb.Worksheets
         .AddItem Sh.Name
       Next
     End With
     Exit Sub
    End If
  Next
  MsgBox 対象ブック名 & "が、開いてません。"
End Sub

'ブックとシート選択
Private Sub CommandButton2_Click()
  Dim WB2 As Workbook, ShName As String
  On Error Resume Next
  Set WB2 = Workbooks(対象ブック名)
  Err.Clear
  On Error GoTo 0
  If Not WB2 Is Nothing Then
    With ThisWorkbook.Worksheets("Sheet1").OLEObjects("ListBox1").Object
      If .ListIndex < 0 Then
        Set WB2 = Nothing
        Exit Sub
      End If
      ShName = .List(.ListIndex)
    End With
    Workbooks(対象ブック名).Sheets(ShName).Activate
    ActiveWindow.WindowState = xlNormal
    Set WB2 = Nothing
    Exit Sub
  End If
  MsgBox 対象ブック名 & "が、開いてません。"
End Sub

【29566】Re:オプションボタン
お礼  ハッチ  - 05/10/7(金) 19:53 -

引用なし
パスワード
   ▼Jaka さん:

こんばんわ。

やっと解決しました!!
ホントに簡単な間違いをしていました。。。

私の場合の間違えはコレでした
    ↓↓↓↓↓↓
たぶん、簡単な間違いだと思うんですが、シート上に
表示 → ツールバー → コントロールツールボックス(アクティブXコントロール)
のOptionButtonを使っていますか?

コントロールツールボックスのOptionButtonではなくフォームのOptionButtonを
使っていました。
変えてみたところ、ちゃんと動きました。

解決してとても嬉しいです♪
どうもありがとうございます!

【29572】Re:オプションボタン
質問  Komo  - 05/10/8(土) 0:04 -

引用なし
パスワード
   ▼Jaka さん:

出来の悪い生徒で申し訳ありません。
でも、本当にありがとうございます。もう少し勉強させてください。

>たぶん、簡単な間違いだと思うんですが、シート上に
>表示 → ツールバー → コントロールツールボックス(アクティブXコントロール)
>のOptionButtonを使っていますか?

ここで間違っていました。→UserForm1の「ツールボックス」のオプションボタンを使っていました。コントロールツールボックスの意味が分かりませんでした。というか、思い過ごしていました。またこれに関して、全く知識がありませんでした。恥ずかしい次第ですが。・・・ユーザーフォームを使わない理由があるのでしょうね。

>また、私の確認用コードは標準モジュールで良いです。

はい、順調に確認できました。ありがとうございます。「プションボタン1・・・3など順調に選択したボタンの表示がMsgBoxに出てきます。

>りんさんのコードで、Private Sub CommandButton1_Click()の方は、
>シートのCommandButtonでも、ユーザーフォーム上のCommandButtonのどちらでからでも動きました。

りんさんのコードを再度させていただきました。シートのコマンドボタンからOKでした。また、ユーザーフォーム上のCommandButtonも順調に動きました。(でも、ユーザーフォームを出すために、UserForm1.Show のコマンドボタンを作る必要がありますね)
コントロールツールボックスやユーザフォーム上のツールボックスの用途やシート上の
フォームの使い分けなどをこれから勉強しなくては・・・と思いました。


>今一歩、どういった状態で使用しているのか、OptionButtonの種類等が解らないので、リストボックスを使った物を作ってみました。

大変ありがとうございます。

>シート上に、アクティブXコントロールの「ListBox」1つ。
>リスト作成用、シート選択用にアクティブXコントロールの「CommandButton」2つ。

ここのListBoxやCommandButtonは・・・→表示 → ツールバー → コントロールツールボックスのやり方で問題ないですね。

>が、"Sheet1"にあるとして、
>下記コードは、ボタン等があるSheet1のシートモジュールに。

はい、やりました。
結果は、MsgBoxに「Book1が、開いていません。」となりました(CommandButton 2つとも)。ListBoxは何ら変化ないです。
また、一寸どこかで間違っていますね。また明日挑戦してみます。分からなかったらまた聞かせていただきたいと思います。

>
>*************
>Const 対象ブック名 As String = "Book1" '←対象ブック名に変更してください。

対象ブック名に変更・・・?これはどういう意味なんでしょうか?


>'シートリスト作成
>Private Sub CommandButton1_Click()
>  Dim Wb As Workbook, Sh As Worksheet
>  For Each Wb In Workbooks
>    If Wb.Name = 対象ブック名 Then
>     With ThisWorkbook.Worksheets("Sheet1").OLEObjects("ListBox1").Object
>       .Clear
>       For Each Sh In Wb.Worksheets
>         .AddItem Sh.Name
>       Next
>     End With
>     Exit Sub
>    End If
>  Next
>  MsgBox 対象ブック名 & "が、開いてません。"
>End Sub
>
>'ブックとシート選択
>Private Sub CommandButton2_Click()
>  Dim WB2 As Workbook, ShName As String
>  On Error Resume Next
>  Set WB2 = Workbooks(対象ブック名)
>  Err.Clear
>  On Error GoTo 0
>  If Not WB2 Is Nothing Then
>    With ThisWorkbook.Worksheets("Sheet1").OLEObjects("ListBox1").Object
>      If .ListIndex < 0 Then
>        Set WB2 = Nothing
>        Exit Sub
>      End If
>      ShName = .List(.ListIndex)
>    End With
>    Workbooks(対象ブック名).Sheets(ShName).Activate
>    ActiveWindow.WindowState = xlNormal
>    Set WB2 = Nothing
>    Exit Sub
>  End If
>  MsgBox 対象ブック名 & "が、開いてません。"
>End Sub

それから、再度お聞きしたい事が在ります。
10月3日の
貴殿のご指摘いただいた下の内容は、あえて変更する必要は無いですね。
Flgの意味が分から無いもので又、勉強させていただきます。
コードはしっかりと残しておいて、又の機会に質問させていただきたく
考えています。

(10月3日の貴殿からのご解答です)
こんにちは。
部分的にしか見てないけれど...。
こうしたらどうでしょうか?

>  '対応するシート名が無いとエラーになるので注意
>  wb.Worksheets(wsn).Activate
   ↓
  Dim WBK As Worksheet, Flg As Boolean
  For Each WBK In wb.Worksheets
    If WBK.Name = wsn Then
      Flg = True
      Exit For
    End If
  Next
  If Flg = True Then
    wb.Worksheets(wsn).Activate
  Else
    msgbox wsn& "シートがありません。"
  End If

Jakeさんに長々とご指導いただきありがとうございます。
感謝しています。特に今回は「コントロールツールボックス」に触れ少し理解ができた事は大きな収穫だったと思っています。
失礼します。

【29613】Re:オプションボタン
発言  りん E-MAIL  - 05/10/9(日) 12:35 -

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

>>たぶん、簡単な間違いだと思うんですが、シート上に
>>表示 → ツールバー → コントロールツールボックス(アクティブXコントロール)
>>のOptionButtonを使っていますか?
>
>・・・ユーザーフォームを使わない理由があるのでしょうね。
 
当初の質問が、
>▼ハッチ さん:
>はじめまして。初心者です。
>すみませんが、マクロをどう組んだらいいのかがわからないのでどなたか教えてください。
>オプションボタンでA,B,C,D,Eの5人の担当者のボタンを作りました。(ワークシートに直接作ってあります。)
だからです。


>>*************
>>Const 対象ブック名 As String = "Book1" '←対象ブック名に変更してください。
>
>対象ブック名に変更・・・?これはどういう意味なんでしょうか?
何度もしようするブックを保存するときに、Book1.xlsと名づけることはほとんど無いとおもわれます。
また、Book1というのは、エクセルを起動して一つ目に表示される、未保存の状態のブック名なので、すでに準備されているブックを対象とする今回のコードとは縁がないと思われます。

>>    Workbooks(対象ブック名).Sheets(ShName).Activate
オプションボタンで分岐して、シートを表示したいブック名を指定して欲しいということですね。

>Flgの意味が分から無いもので又、勉強させていただきます。
FlgはBoolean(ブール)型で宣言されている変数なので、TrueまたはFalseで処理を分岐したい時に使うと便利です。

下の例の場合は、シートの名前をチェックして、一致するものがあればTrueを返します。
シートが見つからなくて最後までループが回りきると、FlgはTrueにならないのでFlgがTrueの時はシートをアクティブに、それ以外の時は見つからなかったとして分岐することができます。
>>  '対応するシート名が無いとエラーになるので注意
>>  wb.Worksheets(wsn).Activate
>   ↓
>  Dim WBK As Worksheet, Flg As Boolean
>  For Each WBK In wb.Worksheets
>    If WBK.Name = wsn Then
wsnと一致するシート名がある場合はFlg=Trueとしてループから抜ける
(見つけたので、ここから先はチェックしなくていい)
>      Flg = True
>      Exit For
>    End If
>  Next

ここで分岐
>  If Flg = True Then
>    wb.Worksheets(wsn).Activate
>  Else
>    msgbox wsn& "シートがありません。"
>  End If

Jaka さん、いろいろありがとうございました。
ちょっとPCにトラブルがあったので、携帯でしか見れませんでした。

【29666】勘違いしてました。(勘違いしたまま、開...
発言  Jaka  - 05/10/11(火) 10:17 -

引用なし
パスワード
   こんにちは。
対象ブックを開くと言う動作が途中であったんですね。
修正コードを書いておいて、今まで「開いている全ブックのシートを切り替えて選択したい。」だと思ってました。
ブックを開く事は、頭に入っていませんでした。

勘違いしたまま作っちゃったので、そのまま載せます。
作ったといっても、、前の作ったアクティブなブック対称だった物を、開いている全ブックでも使えるように手を加えただけですけど...。
コードの内のサイズ位置等の計算などは、何をやって何を意味しているのか、すっかり忘れてしまったので、ステップ実行しながら調整しました。余計なコードもかなり残ってます。
また、開いているブックがすべて対象だといっても、せいぜい4、5枚だろうと思ってますから、不具合の事はわかりませし、修正する気もありません。(ブック枚数に制限をかけてない。)


使用方法
何も無いまっさらなユーザーフォームのフォームモジュールにコピペして、フォームをShowするだけです。

Public WithEvents CmBottan21 As MSForms.CommandButton
Public WithEvents CmBottan22 As MSForms.CommandButton
                        '45
Const 行間隔 As Long = 16, ボタン基準値 As Long = 45, Fm標準Hi As Long = 160
Const Fm標準Wd As Long = 240, OptonBt標準数 = 5
Const OptTop1 As Long = 3

Private Sub CmBottan21_Click()
  Unload Me
  End
End Sub

Private Sub CmBottan22_Click()
  Dim MitOP_Obj As Object, PoSHnm As String
  Dim PagBKnm As String, SelBkn As String
  With Me.Controls.Item("マルチページ")
    PagBKnm = .Pages(.Value).Caption
    For Each MitOP_Obj In .Pages(.Value).Controls
      If MitOP_Obj.Value Then
       PoSHnm = MitOP_Obj.Caption
       Exit For
      End If
    Next
  End With
  If PoSHnm <> "" Then
    SelBkn = PagBKnm
    For Each WB In Workbooks
      If WB.Name = PagBKnm & ".xls" Then
       SelBkn = PagBKnm & ".xls"
       Exit For
      End If
    Next
    Workbooks(SelBkn).Sheets(PoSHnm).Activate
    If ActiveWindow.WindowState = xlMinimized Then
     ActiveWindow.WindowState = xlNormal
    End If
    'MsgBox PagBKnm & vbLf & PoSHnm
  Else
    MsgBox "OptionButton選択無"
  End If
End Sub

'Private Sub UserForm_Click()
Private Sub UserForm_Initialize()
  Dim WB As Workbook, MaxWSC As Integer, Wbc As Integer
  For Each WB In Workbooks
    If WB.Sheets.Count > MaxWSC Then
      MaxWSC = WB.Sheets.Count
    End If
  Next
  If MaxWSC > 60 Then
    MaxWSC = 60
    MsgBox "シート枚数の多すぎるBookがあります。" & vbCrLf & _
       "現在のシート枚数には、対応しておりません。" & vbCrLf & _
       "最高60枚、それ以上は表示されません。", vbExclamation
  End If
  MulTop = 3
  Me.Height = Fm標準Hi
  Me.Width = Fm標準Wd
  Me.Caption = "シート選択"

  Set MultiPage作成 = Me.Controls.Add("Forms.MultiPage.1", "マルチページ")
  With MultiPage作成
    .Left = 10
    .Width = Me.Width - 25
    .Top = MulTop

    For Wbc = 1 To Workbooks.Count
      If Wbc > 2 Then
       .Pages.Add , , .Count
      End If
      BNem = Application.Substitute(Workbooks(Wbc).Name, ".xls", "")
      .Item(Wbc - 1).Caption = BNem

      'Jは、OptionButtonの区切り個数
      n = 0
      Select Case MaxWSC
        Case Is <= 10
         j = 5
         Me.Height = Fm標準Hi   '標準状態
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 135
        Case Is <= 16
         j = Application.RoundUp(16 / 2, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 135
        Case Is <= 20
         j = Application.RoundUp(20 / 2, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 135
        Case Is <= 30
         j = Application.RoundUp(30 / 3, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 340 - 105 '340 - 150
         Me.Width = 340
        Case Is <= 35
         j = Application.RoundUp(35 / 3, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 340 - 105
         Me.Width = 340
        Case Is <= 45
         j = Application.RoundUp(45 / 3, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 340 - 105
         Me.Width = 340
       Case Is <= 60
         j = Application.RoundUp(60 / 4, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         Me.Width = 440
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = Me.Width - 105
      End Select
      .Height = Me.Height - ボタン基準値 - 行間隔 + OptTop1
      .Width = Me.Width - 25
      '.Value = Wbc - 1 'あとで消す
      For i = 1 To Workbooks(Wbc).Worksheets.Count
        If n = j Then
         n = 0
        End If
        n = n + 1
        Set MultiPage = MultiPage作成(Wbc - 1).Controls.Add("Forms.OptionButton.1", "MOptionButton" & i)
        With MultiPage作成(Wbc - 1).Controls("MOptionButton" & i)
          If i <= j Then
           .Left = 7
          ElseIf i <= j * 2 Then
           .Left = 120
          ElseIf i <= j * 3 Then
           .Left = 225
          Else
           .Left = 325
          End If
          If n = 1 Then
           .Top = OptTop1 '0
          Else
           .Top = n * 行間隔 - 行間隔 + OptTop1
          End If
          .Height = 行間隔
          .Caption = Workbooks(Wbc).Worksheets(i).Name
        End With
      Next
      W = 0
    Next
    If Wbc - 1 = 1 Then
      .Pages(1).Visible = False
    End If
    .Height = Me.Height - MulTop - 55
    '.Value = 0 'あとで消す
  End With

  Set CmBottan21 = Me.Controls.Add("Forms.CommandButton.1", "終了ボタン")
  With Me.Controls("終了ボタン")
    .Caption = "終 了"
    .Width = 75
    .Top = ボタン位置高 - OptTop1
    .Left = 25
    .SetFocus
  End With
  Set CmBottan22 = Me.Controls.Add("Forms.CommandButton.1", "選択ボタン")
  With Me.Controls("選択ボタン")
    .Caption = "シート選択"
    .Width = 75
    .Top = ボタン位置高 - OptTop1
    .Left = 実行ボタン位置横
  End With
End Sub

【45328】今ごろですが。
発言  Jaka  - 06/12/19(火) 16:29 -

引用なし
パスワード
   多ブックにて、某ブックのシートの選択(複数可)。
(単に使っているアドインに入ってるコードのコピペ。)
上記レスのオプションボタンでなく、チェックボックス仕様。

フォームモジュール

Public WithEvents CmBottan21 As MSForms.CommandButton
Public WithEvents CmBottan22 As MSForms.CommandButton
                        '45
Const 行間隔 As Long = 16, ボタン基準値 As Long = 45, Fm標準Hi As Long = 160
Const Fm標準Wd As Long = 240, OptonBt標準数 = 5
Const ChkTop1 As Long = 3

Private Sub CmBottan21_Click()
  Unload Me
  End
End Sub

Private Sub CmBottan22_Click()
  Dim MitOP_Obj As Object, PoSHnm() As String
  Dim PagBKnm As String, SelBkn As String, CT As Long
  CT = 0
  With Me.Controls.Item("マルチページ")
    PagBKnm = .Pages(.Value).Caption
    For Each MitOP_Obj In .Pages(.Value).Controls
      If MitOP_Obj.Value Then
       CheckCnt = CheckCnt + 1
       ReDim Preserve PoSHnm(1 To CheckCnt)
       PoSHnm(CheckCnt) = MitOP_Obj.Caption
       CT = 1
      End If
    Next
  End With
  On Error Resume Next
  If CT > 0 Then
    SelBkn = PagBKnm
    For Each WB In Workbooks
      If WB.Name = PagBKnm & ".xls" Then
       SelBkn = PagBKnm & ".xls"
       Exit For
      End If
    Next
    Workbooks(SelBkn).Activate
    Sheets(PoSHnm).Select
    If ActiveWindow.WindowState = xlMinimized Then
     ActiveWindow.WindowState = xlNormal
    End If
    'MsgBox PagBKnm & vbLf & PoSHnm
  Else
    MsgBox "CheckBoxチェック無"
  End If
  Erase PoSHnm
End Sub

'Private Sub UserForm_Click()
Private Sub UserForm_Initialize()
  Dim WB As Workbook, MaxWSC As Integer, Wbc As Integer
  For Each WB In Workbooks
    If WB.Sheets.Count > MaxWSC Then
      MaxWSC = WB.Sheets.Count
    End If
  Next
  If MaxWSC > 60 Then
    MaxWSC = 60
    MsgBox "シート枚数の多すぎるBookがあります。" & vbCrLf & _
       "現在のシート枚数には、対応しておりません。" & vbCrLf & _
       "最高60枚、それ以上は表示されません。", vbExclamation
  End If
  MulTop = 3
  Me.Height = Fm標準Hi
  Me.Width = Fm標準Wd
  Me.Caption = "シート選択"

  Set MultiPage作成 = Me.Controls.Add("Forms.MultiPage.1", "マルチページ")
  With MultiPage作成
    .Left = 10
    .Width = Me.Width - 25
    .Top = MulTop

    For Wbc = 1 To Workbooks.Count
      If Wbc > 2 Then
       .Pages.Add , , .Count
      End If
      BNem = Application.Substitute(Workbooks(Wbc).Name, ".xls", "")
      .Item(Wbc - 1).Caption = BNem

      'Jは、OptionButtonの区切り個数
      n = 0
      Select Case MaxWSC
        Case Is <= 10
         j = 5
         Me.Height = Fm標準Hi   '標準状態
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 135
        Case Is <= 16
         j = Application.RoundUp(16 / 2, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 135
        Case Is <= 20
         j = Application.RoundUp(20 / 2, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 135
        Case Is <= 30
         j = Application.RoundUp(30 / 3, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 340 - 105 '340 - 150
         Me.Width = 340
        Case Is <= 35
         j = Application.RoundUp(35 / 3, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 340 - 105
         Me.Width = 340
        Case Is <= 45
         j = Application.RoundUp(45 / 3, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = 340 - 105
         Me.Width = 340
       Case Is <= 60
         j = Application.RoundUp(60 / 4, 0)
         Me.Height = Fm標準Hi + 行間隔 * (j - OptonBt標準数)
         Me.Width = 440
         ボタン位置高 = Me.Height - ボタン基準値
         実行ボタン位置横 = Me.Width - 105
      End Select
      .Height = Me.Height - ボタン基準値 - 行間隔 + ChkTop1
      .Width = Me.Width - 25
      '.Value = Wbc - 1 'あとで消す
      For i = 1 To Workbooks(Wbc).Worksheets.Count
        If n = j Then
         n = 0
        End If
        n = n + 1
        Set MultiPage = MultiPage作成(Wbc - 1).Controls.Add("Forms.CheckBox.1", "MCheckBox" & i)
        With MultiPage作成(Wbc - 1).Controls("MCheckBox" & i)
          If i <= j Then
           .Left = 7
          ElseIf i <= j * 2 Then
           .Left = 120
          ElseIf i <= j * 3 Then
           .Left = 225
          Else
           .Left = 325
          End If
          If n = 1 Then
           .Top = ChkTop1 '0
          Else
           .Top = n * 行間隔 - 行間隔 + ChkTop1
          End If
          .Height = 行間隔
          .Caption = Workbooks(Wbc).Worksheets(i).Name
        End With
      Next
      W = 0
    Next
    If Wbc - 1 = 1 Then
      .Pages(1).Visible = False
    End If
    .Height = Me.Height - MulTop - 55
    '.Value = 0 'あとで消す
  End With

  Set CmBottan21 = Me.Controls.Add("Forms.CommandButton.1", "終了ボタン")
  With Me.Controls("終了ボタン")
    .Caption = "終 了"
    .Width = 75
    .Top = ボタン位置高 - ChkTop1
    .Left = 25
    .SetFocus
  End With
  Set CmBottan22 = Me.Controls.Add("Forms.CommandButton.1", "選択ボタン")
  With Me.Controls("選択ボタン")
    .Caption = "シート選択"
    .Width = 75
    .Top = ボタン位置高 - ChkTop1
    .Left = 実行ボタン位置横
  End With
End Sub

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