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

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

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

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

No.8 回答者： tatsu99 回答日時： 2019/12/04 19:52

>アドバイスありがとうございます。

>変えてみたんですが、やはりチカチカしてしまいす。
No6です。
UserForm1の中にテキストボックスがありませんか。
テキストボックスがあると、チカチカします。テキストボックスを全て削除してください。
できれば、UserForm1内のコントロールはLabel1だけにしてください。

この回答へのお礼

何度もアドバイスありがとうございます。
テキストをラベルにして１つにしたり、screenupdatingなどで画面を停止させようとしていますが、やはりチカチカしてしまいます...(´･ω･)

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

No.7 回答者： GooUserラック 回答日時： 2019/12/04 18:09

とりあえずコード掲載にチャレンジしてみます。

☆ 標準モジュール Module1 へ

Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" ( _
　　　　ByVal lpszName As String, _
　　　　ByVal hModule As Long, _
　　　　ByVal dwFlags As Long) As Long

Public Const Day_デフォ時間① As Date = #12:03:00 AM# ' ３分
Public Const Day_デフォ時間② As Date = #12:05:00 AM# ' ５分
Public Const Day_デフォ時間③ As Date = #1:00:00 AM#　' １時間
Public Const Str_アラーム音① As String = "Alarm.wav" ' アラーム①用のファイル
Public Const Str_アラーム音② As String = "Alarm.wav" ' アラーム②用のファイル
Public Const Str_アラーム音③ As String = "Alarm.wav" ' アラーム③用のファイル
Public Boo_カウント中 As Boolean
Public Day_セット時刻① As Date
Public Day_セット時刻② As Date
Public Day_セット時刻③ As Date

Public Sub 音再生(ファイル名 As String)

　Call PlaySound(ThisWorkbook.Path & "\" & ファイル名, 0, 1)

End Sub

Sub 起動()

　UserForm1.Show vbModeless

End Sub

Sub カウント(Optional ダミー As Byte)
'※「Optional ダミー As Byte」はマクロリストにこの「カウント」を表示させない為です。

　If Boo_カウント中 Then
　　UserForm1.TextBox0.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
　　Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
　End If

End Sub

☆ 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 = "Start" Then
　　Me.TextBox1.Enabled = False
　　Day_セット時刻① = Now
　　Var_時 = Split(Me.TextBox1.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 = "Stop"
　　Me.CommandButton10.Caption = "P"
　Else
　　Me.TextBox1.Enabled = True
　　Me.TextBox1.Value = WorksheetFunction.Text(Day_デフォ時間①, "[h]:mm:ss")
　　Me.CommandButton1.Caption = "Start"
　　Me.CommandButton10.Caption = "C"
　　With Me.TextBox1
　　　.SetFocus
　　　.SelStart = 0
　　　.SelLength = Len(.Text)
　　End With
　End If

End Sub

Private Sub CommandButton10_Click()
　
　If Me.CommandButton10.Caption = "C" Then
　　Me.TextBox1.Value = WorksheetFunction.Text(Day_デフォ時間①, "[h]:mm:ss")
　Else
　　Me.TextBox1.Enabled = True
　　Me.CommandButton1.Caption = "Start"
　　Me.CommandButton10.Caption = "C"
　End If

End Sub

Private Sub CommandButton2_Click()
' 省略「Private Sub CommandButton1_Click()」を参考に
End Sub

Private Sub CommandButton20_Click()
' 省略「Private Sub CommandButton10_Click()」を参考に
End Sub

Private Sub CommandButton3_Click()
' 省略「Private Sub CommandButton1_Click()」を参考に
End Sub

Private Sub CommandButton30_Click()
' 省略「Private Sub CommandButton10_Click()」を参考に
End Sub

Private Sub TextBox0_Change()

　If Me.CommandButton1.Caption = "Stop" Then
　　If Day_セット時刻① > Now Then
　　　Me.TextBox1.Value = WorksheetFunction.Text(Day_セット時刻① - Now, "[h]:mm:ss")
　　Else
　　　Call 音再生(Str_アラーム音①)
　　　Me.TextBox1.Enabled = True
　　　Me.TextBox1.Value = WorksheetFunction.Text(Day_デフォ時間①, "[h]:mm:ss")
　　　Me.CommandButton1.Caption = "Start"
　　　Me.CommandButton10.Caption = "C"
　　End If
　End If
　If Me.CommandButton2.Caption = "Stop" Then
' 省略「If Me.CommandButton1.Caption = "Stop" Then」を参考に
　End If
　If Me.CommandButton3.Caption = "Stop" Then
' 省略「If Me.CommandButton1.Caption = "Stop" Then」を参考に
　End If

End Sub

Private Sub UserForm_Activate()

　With Me.TextBox1
　　.SetFocus
　　.SelStart = 0
　　.SelLength = Len(.Text)
　End With

End Sub

Private Sub UserForm_Initialize()

　Me.TextBox1.Value = WorksheetFunction.Text(Day_デフォ時間①, "[h]:mm:ss")
　Me.TextBox2.Value = WorksheetFunction.Text(Day_デフォ時間②, "[h]:mm:ss")
　Me.TextBox3.Value = WorksheetFunction.Text(Day_デフォ時間③, "[h]:mm:ss")
　Boo_カウント中 = True
　Call カウント

End Sub

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

End Sub

No.6 回答者： tatsu99 回答日時： 2019/12/04 12:09

＞ためしたところカーソルがカチカチしてしまい、止めさせる方法はないでしょうか？

UserFormにテキストボックスでなくLabelをつけて

UserForm1.TextBox1 = sec2mmss(diff)を
UserForm1.Label1.Caption = sec2mmss(diff)
にしてみてください

この回答へのお礼

アドバイスありがとうございます。
変えてみたんですが、やはりチカチカしてしまいす。

お礼日時：2019/12/04 17:29

No.5 回答者： GooUserラック 回答日時： 2019/12/04 11:58

No.4 へのお礼について

実はマクロを無効にされても、コードを消されるわけではありません。ご自分でマクロを作成した時と同じように処理して保存して一度閉じると、次回使えるようになる場合があります。特にデジタル署名を使っている場合はご自分で署名しなおすと使える事が多いです。

この回答へのお礼

アドバイスありがとうございます。
会社のPCのため、ブックを開くこと自体が出来ておりません...。残念です(ToT)

お礼日時：2019/12/04 17:31

No.4 回答者： GooUserラック 回答日時： 2019/12/04 02:37

No.3 の追補

手動動作ではなくプログラムからのカウントダウンの開始方法の例
（２分３０秒のカウントダウンを２番目のカウンタを使って開始する場合）

Sub Sample()

　UserForm1.TextBox2.Enabled = False
　Day_セット時刻② = Now + #12:02:30 AM#
　UserForm1.CommandButton2.Caption = "Stop"
　UserForm1.CommandButton20.Caption = "P"

End Sub

なお「#12:02:30 AM#」は「#00:02:30#」と時間を指定しても VBE が勝手にアメリカ形式(?)に直してしまうものです。
また別のカウンタを使用する場合は下図の赤枠で囲んだところを修正して下さい。

この回答へのお礼

アドバイスありがとうございます。
セキュリティの関係上、ダウンロードしたところマクロを無効にします、と表示されてしまいました(泣)

お礼日時：2019/12/04 11:42

No.3 回答者： GooUserラック 回答日時： 2019/12/04 01:45

No.2 の補足（使い方などはダウンロードファイルに同梱されている「Manual.pdf」を見て下さい）

--------------------------------------------------------------------------------------
Public Boo_カウント中 As Boolean

Sub カウント(Optional ダミー As Byte)

　If Boo_カウント中 Then
　　UserForm1.TextBox0.Value = Format(Now, "yyyy/mm/dd hh:nn:ss")
　　Call Application.OnTime(DateAdd("s", 1, Now()), "カウント")
　End If

End Sub
--------------------------------------------------------------------------------------
上記はコードの一部です。
「Application.OnTime」メゾットを使って「UserForm1.TextBox0」を毎秒書き換えています。
なぜラベルで無くテキストボックスに書き込んでいるかというと、ラベルには「Change」イベントが無いためです。実際のカウントダウンなどはこのイベントを使うので「Application.OnTime」メゾットへの影響がほとんどなくなります。
基本では時間になると音を鳴らしますが「Call 音再生(Str_アラーム音①)」などを変更すれば別の動作も可能です。
--------------------------------------------------------------------------------------
☆ 使用方法
・②に時間をセットします。④の｢C｣ボタンを押すとデフォルト時間がセットされます。
・③の｢Start｣ボタンを押すと、｢Start｣ボタンが｢Stop｣に④の｢C｣ボタンが｢P｣にそれぞれ変わり②のカウントダウンが始まります。
・カウントダウン中に③の｢Stop｣ボタンを押すと､②にデフォルト時間がセットされ､｢Stop｣ボタンが｢Start｣に④の｢P｣ボタンが｢C｣にそれぞれ変わりカウントダウンが止まります。
・カウントダウン中に④の｢P｣ボタンを押すと､③の｢Stop｣ボタンが｢Start｣に､｢P｣ボタンが｢C｣にそれぞれ変わりカウントダウンが止まります。
・②が｢0:00:00｣になると､アラームが鳴り､②にデフォルト時間がセットされ､③の｢Stop｣ボタンが｢Start｣に､④の｢P｣ボタンが｢C｣にそれぞれ変わりカウントダウンが止まります。
--------------------------------------------------------------------------------------
☆ 時間セット例
・ ｢:｣を付けず数字のみセットした場合 ⇒ 時間として認識されます。
【例】 ｢12｣と入力されていた場合｢12:00:00｣と入力されたことになります。
・ ｢:｣を１つのみ使ってセットした場合 ⇒ 時間と分として認識されます。
【例】 ｢12:34｣と入力されていた場合｢12:34:00｣と入力されたことになります。
・ ｢:｣を２つ使ってセットした場合 ⇒ 時間と分と秒として認識されます。
【例】 ｢12:34:56｣と入力されていた場合｢12:34:56｣と入力されたことになります。
・ ｢:｣を３つ以上使ってセットした場合 ⇒ 時間と分と秒として認識され３つ目以降は無視されます。
【例】 ｢12:34:56:78｣と入力されていた場合｢12:34:56｣と入力されたことになります。
・ 通常では使われない大きな数字が入力されていた場合 ⇒ それぞれの単位として認識されます。
【例】 ｢45:67:89｣と入力されていた場合｢46:08:29｣と入力されたことになります。
・ 分のみセットしたい時は ｢:｣で囲んで分を入力する。
【例】 ｢:1:｣と入力されていた場合｢0:01:00｣と入力されたことになります。
・ 秒のみセットしたい時は ｢::｣の後に秒を入力する。
【例】 ｢::12｣と入力されていた場合｢0:00:12｣と入力されたことになります。

No.2 回答者： GooUserラック 回答日時： 2019/12/04 00:16

私の作ったものならそんなことはないですよ。

パスワードなどかけてないので研究してみて下さい
以下のページの左側の目次の「カウントダウンタイマー」をクリックしてダウンロードページを開いて下さい。
ＵＲＬ「 https://luckshp.web.fc2.com/ 」

No.1 回答者： tatsu99 回答日時： 2019/12/03 22:54

Sheet1のB2に分、D2に秒を指定したタイマーです。

UserForm1.TextBox1に残り時間を表示します。
ポイントはApplication.OnTimeを使用する点です。
標準モジュールに登録します。
Option Explicit
Dim t1_ss As Long
Dim t1_s As Variant
Dim t1_e As Variant

Public Sub タイマー()
Dim t_nn As Long
Dim t_ss As Long
Dim err As Boolean
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
err = False
t_nn = ws.Range("B2").Value
t_ss = ws.Range("D2").Value
If t_nn < 0 Or t_nn > 59 Or t_ss < 0 Or t_ss > 59 Then err = True
t1_ss = t_nn * 60 + t_ss
If t1_ss = 0 Then err = True
If err = True Then
MsgBox ("タイマー不正")
Exit Sub
End If
UserForm1.Show vbModeless
UserForm1.Repaint
t1_s = Now
Call next_timer
End Sub
Private Sub next_timer()
Dim exec_time As Double
Dim diff As Long
t1_e = Now
diff = t1_ss - DateDiff("s", t1_s, t1_e)
UserForm1.TextBox1 = sec2mmss(diff)
If diff <= 0 Then
MsgBox ("Timer終了")
Exit Sub
End If
exec_time = Now() + TimeSerial(0, 0, 1)
Call Application.OnTime(exec_time, "next_timer")
End Sub


Private Function sec2mmss(ByVal cnt_d As Long) As String
Dim nn As Long
Dim ss As Long
Dim amari As Long
nn = cnt_d \ 60
ss = cnt_d Mod 60
sec2mmss = Format(nn, "00") & ":" & Format(ss, "00")
End Function

この回答へのお礼

アドバイスありがとうございます。
ためしたところカーソルがカチカチしてしまい、止めさせる方法はないでしょうか？

お礼日時：2019/12/04 11:44