| |
▼ｔｋ さん：
こんにちは。再送です。
>ラベルの文字について質問させて頂きます。
>フォームである作業を行い、ﾎﾞﾀﾝをクリックしてシートへ更新をしているのですが、この時に、フォーム上にラベルを貼り付けとき、ラベルの中に『登録中・・・』という文字を左から右へスクロール（繰り返し）させ、登録作業が終わった時点で文字が消えるという事をやってみたいのですが、こんなことって可能な事なのでしょうか？
左から右へスクロール（繰り返し）ではなく、右から左へではないですか？
例えば、ユーザーフォーム（Userform1）に
Label1---------------ラベル 文字表示用
Commandbutton1-------ボタン 文字表示開始ボタン
Commandbutton2-------ボタン 文字表示中止ボタン
を配置してください。
標準モジュールに
'===========================================================
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private d_str As String
Private d_idx As Long
Private d_lbl As MSForms.Label
Private d_int As Long
Private d_len As Long
Private d_jdx As Long
'======================================================================
Sub disp_open(ByVal lbl As MSForms.Label, ByVal disp_str As String, Optional ByVal interval As Long = 100)
Dim wk As Double
Set d_lbl = lbl
d_str = disp_str & String(Len(disp_str), " ")
With d_lbl
wk = .ForeColor
.ForeColor = .BackColor
.TextAlign = fmTextAlignRight
.Caption = disp_str
.Font.Name = "ＭＳ 明朝"
.Font.Size = 24
.AutoSize = True
DoEvents
.AutoSize = False
.Caption = ""
.ForeColor = wk
.Height = 24
End With
d_idx = 1
d_jdx = 1
d_int = interval
d_len = Len(disp_str)
End Sub
'===============================================================
Sub disp_proc()
Dim mystr As String
If d_jdx > d_len Then
d_idx = 1
d_lbl.Caption = ""
d_jdx = 1
End If
If d_idx > d_len Then
d_jdx = d_jdx + 1
d_idx = d_len
End If
mystr = Mid(d_str, d_jdx, d_idx)
d_lbl.Caption = mystr
d_idx = d_idx + 1
Sleep d_int
End Sub
'==================================================================
Sub disp_close()
d_str = ""
d_idx = 0
d_lbl.Caption = ""
Set d_lbl = Nothing
End Sub
'↑これを標準モジュールに置く是非の判断は難しいですが・・・。
'クラスモジュールに置くのも良いと思います。
別の標準モジュールに
'=====================================================
sub main()
userform1.show
end sub
UserForm1のモジュールに
'======================================================
Private d_flg As Long
'======================================================
Private Sub CommandButton1_Click()
Call disp_open(Label1, "処 理 中", 300)
d_flg = 1
Do While d_flg = 1
'本来の処理コード
Call disp_proc
DoEvents
Loop
Call disp_close
Label1.Caption = ""
End Sub
'========================================================
Private Sub CommandButton2_Click()
d_flg = 0
End Sub
として、
mainを実行してみてください。
Userform1が表示されます。
Commandbutton1をクリックしてください。
「処 理 中」というメッセージが繰り返し流れます。
表示の中止は、Commandbutton2をクリックしてください。
（Userform1を閉じる前にストップさせてください）
尚、Label1は、メッセージが表示させるのに十分な幅を確保してください。
試してみてください
|
|
ichinose
- 06/7/24(月) 18:34 -
