ユーザーフォームをvbModeless以外の表示方法

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

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

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

No.18 ベストアンサー 回答者： GooUserラック 回答日時： 2019/12/05 15:49

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

この回答へのお礼

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

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

No.17 回答者： GooUserラック 回答日時： 2019/12/05 15:40

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

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

'---------------------------------------------
☆ 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

No.16 回答者： GooUserラック 回答日時： 2019/12/05 15:10

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

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

No.15 回答者： GooUserラック 回答日時： 2019/12/05 14:45

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

No.14 回答者： GooUserラック 回答日時： 2019/12/05 14:34

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
-----------------------------------------------------------------------------------------
に差替えてみて下さい。

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

No.13 回答者： tatsu99 回答日時： 2019/12/05 14:10

No10です。

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

No.12 回答者： GooUserラック 回答日時： 2019/12/05 13:29

No.11 の訂正です

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

No.11 回答者： GooUserラック 回答日時： 2019/12/05 13:00

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

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

No.10 回答者： tatsu99 回答日時： 2019/12/05 11:57

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

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

あなたは、ラベルを１つにしても、チカチカするとのことですが、どの部分がチカチカするのでしょうか？
チカチカする部分の画像を表示していただけるとありがたいのですが。

No.9 回答者： GooUserラック 回答日時： 2019/12/05 06:33

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

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

'---------------------------------------------
☆ 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

この回答へのお礼

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

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