いちばん失敗した人決定戦

こんにちは。
ユーザーフォームについて質問させて下さい。
ネットで探したユーザーフォームで作成するタイマーをシート上に表示させています。

https://ateitexe.com/count-down-timer/

ただ、このユーザーフォームを表示している間は検索&置換機能が使えなくて困っています。
セルの入力などはvbModelessで解決出来たのですが、他に方法はないでしょうか?

A 回答 (18件中1~10件)

No.17 の修正です


大変申し訳ございません。ユーザーフォームを閉じるとポインターが変化しなくなっていました。

'---------------------------------------------
☆ Module1 へ
'---------------------------------------------

Public Const Day_デフォルト As Date = #12:00:00 AM#
Public Day_セット時刻 As Date
Public Boo_カウント中 As Boolean
Public Lng_ポインタ As Long

Public Sub 時間になった時の処理()
 '時間になった時の行いたい処理をここに書き込んでください。
End Sub

Sub タイマー表示()
 UserForm1.Show vbModeless
End Sub

Sub カウント(Optional ダミー As Byte)
 Application.Cursor = Lng_ポインタ
 If Boo_カウント中 Then
  UserForm1.TextBox1.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
  Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
  DoEvents
  Application.Cursor = xlDefault
  Lng_ポインタ = Application.Cursor
 Else
  Application.Cursor = xlDefault
 End If
End Sub
    • good
    • 0
この回答へのお礼

助かりました

返信が遅くなり申し訳ありません。
無事に希望通りになりました。
自分じゃたどり着けなかったので本当にありがとうございました!!

お礼日時:2019/12/10 16:51

もしも、ポインターの変化が1秒に1回(反応が悪くなる)で良ければ以下のように標準モジュールを変更して下さい。

ほとんどどこにあってもチカチカしません。

'---------------------------------------------
☆ Module1 へ
'---------------------------------------------

Public Const Day_デフォルト As Date = #12:00:00 AM#
Public Day_セット時刻 As Date
Public Boo_カウント中 As Boolean
Public Lng_ポインタ As Long

Public Sub 時間になった時の処理()
 '時間になった時の行いたい処理をここに書き込んでください。
End Sub

Sub タイマー表示()
 UserForm1.Show vbModeless
End Sub

Sub カウント(Optional ダミー As Byte)
 Application.Cursor = Lng_ポインタ
 If Boo_カウント中 Then
  UserForm1.TextBox1.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
  Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
 End If
 DoEvents
 Application.Cursor = xlDefault
 Lng_ポインタ = Application.Cursor
End Sub
    • good
    • 0

もう一つ気づいたことが有ります。



ユーザーフォームがエクセル上に有ると症状が出やすいみたいです。
エクセル上で無い場所に移動するとほとんど症状が出なくなります。
(この状態でテストしていたため時々しか症状が出ませんでした)
    • good
    • 0

No.14 修正(ダミーの代わりにポインタを使いました)



Sub カウント(Optional ポインタ As Long)
 ポインタ = Application.Cursor
 Application.Cursor = ポインタ
 If Boo_カウント中 Then
  UserForm1.TextBox1.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
  Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
 End If
 Application.Cursor = xlDefault
End Sub
    • good
    • 0

No.9 の修正



少しは「チカチカ」が減るかもしれません。お試し下さい。
-----------------------------------------------------------------------------------------
Sub カウント(Optional ダミー As Byte)
 If Boo_カウント中 Then
  UserForm1.TextBox1.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
  Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
 End If
End Sub
-----------------------------------------------------------------------------------------

-----------------------------------------------------------------------------------------
Sub カウント(Optional ダミー As Byte)
Dim ポインタ As Long
 ポインタ = Application.Cursor
 Application.Cursor = ポインタ
 If Boo_カウント中 Then
  UserForm1.TextBox1.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
  Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
 End If
 Application.Cursor = xlDefault
End Sub
-----------------------------------------------------------------------------------------
に差替えてみて下さい。

こちらでは一瞬ポインターが消える事はありますが気にならない程度になりました。
    • good
    • 0

No10です。


>ためしたところカーソルがカチカチしてしまい、止めさせる方法はないでしょうか?
チカチカするのは、文字入力用のカーソルではなく、マウスのポインターのことだったのですね。
それであれば、No11のかたの回答通りになります。
    • good
    • 0

No.11 の訂正です



「マウスカーソル」は「マウスポインター」に読み替えて下さい。
「・ マウスカーソルの形状を通常時の物とビジー時の物を同じものにする」は削除して下さい。
    • good
    • 0

「チカチカ」の件ですが、長い事置いておいたら時々発生する事を確認しました。


どうやら「Application.OnTime」が起動した瞬間にマウスカーソルの形状が変わる時があるようです。これは「Application.OnTime」を使っている限り仕方が無いようです。(バックグラウンドでウィルススキャンが活発になっても見えてしまうようです、つまり重い作業時はもちろん、何もしないときも発生しやすいみたいです)
対応方法としては以下のような方法になると思いますが、どれもあまりお勧めできません
・「Application.OnTime」を使かわない(今のところ別の有用な方法は知りません)
・「Application.OnTime」の発生間隔を減らす
・ PCを性能の高い物に変える
・ 作業中はバックグラウンドでウィルススキャンなどを止めておく
・ マウスカーソルの形状を通常時の物とビジー時の物を同じものにする
    • good
    • 0

>テキストをラベルにして1つにしたり、screenupdatingなどで画面を停止させようとしていますが、やはりチカチカしてしまいます...(´・ω・)


添付画像の左側がラベルに表示したケース
添付画像の右側がテキストボックスに表示したケース
になります。
ラベルに表示した場合は、カーソル自体が表示されないのでチカチカしません。
テキストボックスに表示した場合は、カーソル(赤線で囲んだところ)がチカチカします。

あなたは、ラベルを1つにしても、チカチカするとのことですが、どの部分がチカチカするのでしょうか?
チカチカする部分の画像を表示していただけるとありがたいのですが。
「ユーザーフォームをvbModeless以」の回答画像10
    • good
    • 0

カウントダウン欄を1つにし音を鳴らさないものを作りました



ユーザーフォーム下図のような感じで作成して下さい。
 もちろん大きさや配置はご自由に変更して下さい。

'---------------------------------------------
☆ ThisWorkbook へ
'---------------------------------------------

Private Sub Workbook_Open()
 Call タイマー表示
End Sub

'---------------------------------------------
☆ UserForm1 へ
'---------------------------------------------

Private Sub CommandButton1_Click()
Dim Var_時 As Variant
Dim Lng_位置 As Long
 If Me.CommandButton1.Caption = "スタート" Then
  Me.TextBox2.Enabled = False
  Day_セット時刻 = Now
  Var_時 = Split(Me.TextBox2.Value, ":")
  If UBound(Var_時) >= 0 Then
   If IsNumeric(Var_時(0)) Then Day_セット時刻 = DateAdd("h", Var_時(0), Day_セット時刻)
  End If
  If UBound(Var_時) >= 1 Then
   If IsNumeric(Var_時(1)) Then Day_セット時刻 = DateAdd("n", Var_時(1), Day_セット時刻)
  End If
  If UBound(Var_時) >= 2 Then
   If IsNumeric(Var_時(2)) Then Day_セット時刻 = DateAdd("s", Var_時(2), Day_セット時刻)
  End If
  Me.CommandButton1.Caption = "ストップ"
  Me.CommandButton2.Caption = "ポーズ"
 Else
  Me.TextBox2.Enabled = True
  Me.TextBox2.Value = WorksheetFunction.Text(Day_デフォルト, "[h]:mm:ss")
  Me.CommandButton1.Caption = "スタート"
  Me.CommandButton2.Caption = "クリア"
  With Me.TextBox2
   .SetFocus
   .SelStart = 0
   .SelLength = Len(.Text)
  End With
 End If
End Sub

Private Sub CommandButton2_Click()
 If Me.CommandButton2.Caption = "クリア" Then
  Me.TextBox2.Value = WorksheetFunction.Text(Day_デフォルト, "[h]:mm:ss")
 Else
  Me.TextBox2.Enabled = True
  Me.CommandButton1.Caption = "スタート"
  Me.CommandButton2.Caption = "クリア"
 End If
End Sub

Private Sub TextBox1_Change()
 If Me.CommandButton1.Caption = "ストップ" Then
  If Day_セット時刻 > Now Then
   Me.TextBox2.Value = WorksheetFunction.Text(Day_セット時刻 - Now, "[h]:mm:ss")
  Else
   Call 時間になった時の処理
   Me.TextBox2.Enabled = True
   Me.TextBox2.Value = WorksheetFunction.Text(Day_デフォルト, "[h]:mm:ss")
   Me.CommandButton1.Caption = "スタート"
   Me.CommandButton2.Caption = "クリア"
  End If
 End If
End Sub

Private Sub UserForm_Activate()
 With Me.TextBox2
  .SetFocus
  .SelStart = 0
  .SelLength = Len(.Text)
 End With
End Sub

Private Sub UserForm_Initialize()
 Me.TextBox1.Enabled = False
 Me.TextBox2.Value = WorksheetFunction.Text(Day_デフォルト, "[h]:mm:ss")
 Me.CommandButton1.Caption = "スタート"
 Me.CommandButton2.Caption = "クリア"
 Boo_カウント中 = True
 Call カウント
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 Boo_カウント中 = False
End Sub

'---------------------------------------------
☆ Module1 へ
'---------------------------------------------

Public Const Day_デフォルト As Date = #12:00:00 AM#
Public Day_セット時刻 As Date
Public Boo_カウント中 As Boolean

Public Sub 時間になった時の処理()
 '時間になった時の行いたい処理をここに書き込んでください。
End Sub

Sub タイマー表示()
 UserForm1.Show vbModeless
End Sub

Sub カウント(Optional ダミー As Byte)
 If Boo_カウント中 Then
  UserForm1.TextBox1.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
  Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
 End If
End Sub
「ユーザーフォームをvbModeless以」の回答画像9
    • good
    • 0
この回答へのお礼

つらい・・・

アドバイスありがとうございます。
日付も入り、プロっぽい仕様になりました。
ただ、タイマーを作動している間、カーソルがチカチカしてしまい、何とかしろと言われてます。
テキストをラベルにしたり、screenupdatingなどで停止させようとしていますが上手くいかず...。
何か良い方法はないでしょうか?

お礼日時:2019/12/05 10:14

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!