Excel VBA質問箱 IV

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

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


38000 / 76732 ←次へ | 前へ→

【43878】おまけにならないかも。
発言  Jaka  - 06/10/27(金) 13:37 -

引用なし
パスワード
   また、肝心なものを忘れたので、これで3回目
新規フォームモジュールに貼り付けて、フォームを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 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

0 hits

【43868】デバックを非表示にしたいのです azuki 06/10/27(金) 10:16 質問
【43869】Re:デバックを非表示にしたいのです Jaka 06/10/27(金) 10:31 発言
【43876】Re:デバックを非表示にしたいのです azuki 06/10/27(金) 12:34 お礼
【43878】おまけにならないかも。 Jaka 06/10/27(金) 13:37 発言
【43871】Re:デバックを非表示にしたいのです Blue 06/10/27(金) 10:33 回答
【43877】Re:デバックを非表示にしたいのです azuki 06/10/27(金) 12:35 お礼

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