Excel VBA質問箱 IV

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

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


51916 / 76732 ←次へ | 前へ→

【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
1 hits

【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 発言

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