[[20080403180023]] 『メッセージボックスの文字の大きさ』(ののの) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『メッセージボックスの文字の大きさ』(ののの)

マクロでファイルが開いた時にメッセージボックスを表示するようにしていますが、この文字の大きさは変更出来ますか?もっと大きく目立つように表示したいのですが…

XP2000


 ユーザーフォームを使って自作してみては? 

 新規ブックに ユーザーフォーム(Userform1)だけ作成してください
 (コントロールは、コードで作成しますから、配置しないで下さい)。

 標準モジュールに

 '====================================================================
 Function mymsgbox(mes As Variant, Optional ByVal boxtype = 0, Optional ByVal myleft = 0, Optional ByVal mytop = 0, Optional wait As Double = -1, Optional ByVal sz As Long = 11) As Long
 'input :mes ---表示文字列
 '       BOXTYPE 0--「OK」ボタンのみ 1--「OK」「CANCEL」
 '       myleft 水平位置 mytop 垂直位置
 '       wait  表示時間---このパラメータを指定すると、
 '                       指定された時間だけ表示され、自動的に非表示になる
 '       sz    文字サイズ 既定値 11
 'output :mymsgbox 押されたボタンを返す
 '        ok--0 cancel--1
    Dim lbl As MSForms.Label
    Dim btn1 As MSForms.CommandButton
    Dim btn2 As MSForms.CommandButton
    Load UserForm1
    With UserForm1

      .Caption = "VBA Message"
      .StartUpPosition = 0
      .Top = mytop
      .Left = myleft
      Set lbl = .Controls.Add("Forms.Label.1")
      With lbl
        .Font.Size = sz
        .Top = 10
        .Left = 10
        .Caption = mes
        .Width = Len(mes) * sz
        .AutoSize = True
        End With
      Set btn1 = .Controls.Add("Forms.CommandButton.1")
      With btn1
        .Caption = "  OK  "
        .Top = lbl.Top + lbl.Height + 10
        .AutoSize = True
        End With
      Select Case boxtype
        Case 0
          .Width = lbl.Left + lbl.Width + 30
          .Height = btn1.Top + btn1.Height + 30
          btn1.Left = .Width / 2 - btn1.Width / 2
          Set .btn1 = btn1
        Case 1
          Set btn2 = .Controls.Add("Forms.CommandButton.1")
          With btn2
            .Caption = "Cancel"
            .Top = lbl.Top + lbl.Height + 10
            .AutoSize = True
            End With
          btn1.Width = Application.Max(btn1.Width, btn2.Width)
          btn2.Width = btn1.Width
          .Width = Application.Max(lbl.Left + lbl.Width + 10, btn1.Width + 4 + btn2.Width + 30)
          .Height = btn1.Top + btn1.Height + 30
          btn1.Left = .Width / 2 - btn1.Width - 2
          btn2.Left = .Width / 2 + 2
          Set .btn1 = btn1
          Set .btn2 = btn2
        End Select
      If Not IsMissing(wait) Then
         UserForm1.wait = wait
         End If
      .Show
      mymsgbox = .btn_id
      Unload UserForm1
      End With
 End Function

 Userform1のモジュールに

 '====================================================================================
 Option Explicit
 Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 Public btn_id As Long
 Private w_stop As Boolean
 Public wait As Double
 Public WithEvents btn1 As MSForms.CommandButton
 Public WithEvents btn2 As MSForms.CommandButton
 Private Sub btn1_Click()
   btn_id = 0
   w_stop = True
   Me.Hide
 End Sub
 Private Sub btn2_Click()
   btn_id = 1
   w_stop = True
   Me.Hide
 End Sub
 Private Sub UserForm_Activate()
    Dim limtm As Double
    If wait > 0 Then
       limtm = [now()] + wait
       w_stop = False
       btn_id = 0
       Do Until [now()] >= limtm Or w_stop = True
          DoEvents
          Sleep 100
          Loop
       Me.Hide
       End If
 End Sub
 Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = 0 Then
       Cancel = True
       End If
 End Sub

 別の標準モジュールに

 '===========================================================================
 Sub test()
    Dim ans As Long
    mymsgbox "いかがでしょうか?", , 100, 150, TimeValue("00:00:03"), 24
    mymsgbox "いかがでしょうか?", , 100, 150, TimeValue("00:00:03"), 18
    mymsgbox "いかがでしょうか?", , 100, 150, TimeValue("00:00:03"), 14
    mymsgbox "いかがでしょうか?", , 100, 150, TimeValue("00:00:03")
 End Sub

 として、testを実行してみてください。
 一度作成してしまえば、再利用できますよね??
 これに三つボタンも追加してみてください。

 ichinose

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.