[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームのテキストボックスへ自動計算された日付を表示させたい』（さとうとしお）
ユーザーフォーム内にあるテキストボックスへ自動で計算した
日付を表示させたいので教えていただきたくお願いします。
【 】をユーザーフォームのテキストボックスと見立てています。
（１）車検【txt_Ａ】から【txt_Ｂ】
（２）納車【txt_Ｃ】
（３）支払期日【txt_Ｄ】
やりたいこと---
txt_Ａに西暦から日付を手入力する
入力と同時に以下の処理をしたい
↓
txt_Ｂにtxt_Ａから3日後の日付が自動反映
↓
txt_Ｃにtxt_Ａの日付が自動反映
↓
txt_Ｄにtxt_Ａから7日後の日付が自動反映
コマンドボタンなどを使用せず、txt_Ａに8ケタの数字が入力される→計算された日付が表示される、としたいです。
やりたいことここまで---
なぜ、テキストボックスにしているかというと、
上記ルール（何日後）はデフォルトで、９割はそのまま進みますが
表示日付より以降であれば日付は変えることができるためです。
他にも入力項目があるため、全て入力した後にコマンドボタン押下で
テキストボックスに入力の内容を転記させるようにする予定です。
よろしくお願いいたします。
＜ 使用 Excel：Excel2019、使用 OS：unknown ＞
参考まで。
Sub test() Dim dateA As String Dim dateB As String dateA = "2022/11/28" dateB = CDate(dateA) + 7 MsgBox dateB End Sub （MK） 2022/11/28(月) 14:35:14
>txt_Ａに8ケタの数字が入力される
見落としてました。 私のコードはそのままでは使えないので 一工夫必要になります。 （MK） 2022/11/28(月) 14:40:08
修正版です。
Sub test2()
Dim mydate As String Dim dateA As Date Dim dateB As Date mydate = 20221128 dateA = CDate(Format(mydate, "0000/00/00")) dateB = dateA + 7 MsgBox dateB End Sub （MK） 2022/11/28(月) 14:42:56
Private Sub txt_Ａ_Change()
Dim mydate As String
Dim dateA As Date
Dim dateB As Date
Dim dateC As Date
dateA = CDate(Format(txt_Ａ, "@@@@/@@/@@"))
dateB = DateAdd("d", 3, dateA)
dateC = DateAdd("d", 7, dateA)
txt_Ｂ = dateB
txt_Ｃ = dateA
txt_Ｄ = dateC
End Sub
としました。
計算された日付がテキストボックスに表示されるようにできましたが、
日付の表示形式を現在の『yyyy/m/d』から『yy年m月d日（aaa)』にしたいです。
（エクセルシートへ転記の際ではなく、テキストボックスに表示させたい）
よろしくお願いいたします。
（さとうとしお） 2022/11/28(月) 15:57:51
横から失礼します。 既出のFormat関数で可能です。 変数に入れるならString型で。
txt_C = Format(dateA, "yy年m月d日（aaa）") （詠人不知） 2022/11/28(月) 17:53:36
力技で統制してみました ^^; クラス使わない素直なベタ書きです。
UserFormにTextBoxを4個(txt_A,txt_B,txt_C,txt_D)並べて実験
Option Explicit
Private Const DATE_FMT1 = "yy年m月d日(aaa)"
Private Const DATE_FMT2 = "yyyymmdd"
Private dateA_ As Date, dateB_ As Date, dateC_ As Date, dateD_ As Date
Rem ------------------------------------------------------------------------------------------------
Private Property Get dateA() As Date
dateA = dateA_
End Property
Private Property Let dateA(newDate As Date)
If newDate = dateA_ Then Exit Property
dateA_ = newDate
Call SwcFmt(txt_A, dateA_, DATE_FMT1)
dateB = dateA_ + 3
dateC = dateA_ + 0
dateD = dateA_ + 7
End Property
Private Property Get dateB() As Date
dateB = dateB_
End Property
Private Property Let dateB(newDate As Date)
If newDate = dateB_ Then Exit Property
dateB_ = newDate
Call SwcFmt(txt_B, dateB_, DATE_FMT1)
End Property
Private Property Get dateC() As Date
dateC = dateC_
End Property
Private Property Let dateC(newDate As Date)
If newDate = dateC_ Then Exit Property
dateC_ = newDate
Call SwcFmt(txt_C, dateC_, DATE_FMT1)
End Property
Private Property Get dateD() As Date
dateD = dateD_
End Property
Private Property Let dateD(newDate As Date)
If newDate = dateD_ Then Exit Property
dateD_ = newDate
Call SwcFmt(txt_D, dateD_, DATE_FMT1)
End Property
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_A_Enter()
Call SwcFmt(txt_A, dateA, DATE_FMT2)
End Sub
Private Sub txt_A_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_A, dateA, DATE_FMT1)
End Sub
Private Sub txt_A_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_A_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
dateA = RtnDate(txt_A, dateA)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_B_Enter()
Call SwcFmt(txt_B, dateB, DATE_FMT2)
End Sub
Private Sub txt_B_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_B, dateB, DATE_FMT1)
End Sub
Private Sub txt_B_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_B_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
dateB = RtnDate(txt_B, dateB)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_C_Enter()
Call SwcFmt(txt_C, dateC, DATE_FMT2)
End Sub
Private Sub txt_C_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_C, dateC, DATE_FMT1)
End Sub
Private Sub txt_C_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_C_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
dateC = RtnDate(txt_C, dateC)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_D_Enter()
Call SwcFmt(txt_D, dateD, DATE_FMT2)
End Sub
Private Sub txt_D_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_D, dateD, DATE_FMT1)
End Sub
Private Sub txt_D_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_D_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
dateD = RtnDate(txt_D, dateD)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub SwcFmt(ByVal tb As MSForms.TextBox, d As Date, fmt As String)
tb.Text = Format$(d, fmt)
End Sub
Private Sub RtnKeyPress(ByVal key As MSForms.ReturnInteger)
Select Case key.Value
Case Asc("0") To Asc("9"):
Case Else: key.Value = 0
End Select
End Sub
Private Function RtnDate(ByVal tb As MSForms.TextBox, d As Date) As Date
RtnDate = d
If tb.TextLength = 8 Then
Dim tmp As String
tmp = Format$(tb.Text, "0000/00/00")
If IsDate(tmp) Then RtnDate = CDate(tmp)
End If
End Function
（白茶） 2022/11/28(月) 18:57:31
確認が遅くなりました。
ありがとうございます！表示形式が変わりました！
txt_Ａは入力した後に変えることは出来ませんか？
（さとうとしお） 2022/11/30(水) 16:54:58
長いコードを書き込んでくださり大変ありがとうございます。
知らないことばかりで確認していたらお返事が遅くなってしまいました。
申し訳ありません。
まだ、どのコードでどのように動いているのかすべて見れていないのですが、
txt_Ａに入力→エンターキー押下→txt_Ｂがアクティブになる→押下→日付が表示される
となり、それぞれのテキストボックス内でエンターキーを押下しないと日付が表示されないのは
どこを見ればいいですか？
希望はtxt_Ａに入力→エンター→すべての日付が反映
（他の入力項目が非常に多く少しでも時短したい）
自動反映されたテイストボックスへ新たに日付を入力すると曜日も合わせて変わり、
こちらは求めていた機能でしたので非常にうれしいです。
ありがとうございます。
よろしくお願いいたします。
（さとうとしお） 2022/11/30(水) 17:06:49
> txt_Ａに入力→エンターキー押下→txt_Ｂがアクティブになる→押下→日付が表示される > 希望はtxt_Ａに入力→エンター→すべての日付が反映
えーと... よく分かりませんが ^^; とりあえずChangeイベントに変えてみました。(正直、雑な弄り方してますからお気を付け下さい)
Option Explicit
Private Const DATE_FMT1 = "yy年m月d日(aaa)"
Private Const DATE_FMT2 = "yyyymmdd"
Private dateA_ As Date, dateB_ As Date, dateC_ As Date, dateD_ As Date
Private EventOff As Boolean
Rem ------------------------------------------------------------------------------------------------
Private Property Get dateA() As Date
dateA = dateA_
End Property
Private Property Let dateA(newDate As Date)
If newDate = dateA_ Then Exit Property
dateA_ = newDate
If Me.ActiveControl Is txt_A Then
dateB = dateA_ + 3
dateC = dateA_ + 0
dateD = dateA_ + 7
Else
Call SwcFmt(txt_A, dateA, DATE_FMT1)
End If
End Property
Private Property Get dateB() As Date
dateB = dateB_
End Property
Private Property Let dateB(newDate As Date)
If newDate = dateB_ Then Exit Property
dateB_ = newDate
If Me.ActiveControl Is txt_B Then
' dateA = dateB_ - 3
' dateC = dateA_ + 0
' dateD = dateA_ + 7
Else
Call SwcFmt(txt_B, dateB, DATE_FMT1)
End If
End Property
Private Property Get dateC() As Date
dateC = dateC_
End Property
Private Property Let dateC(newDate As Date)
If newDate = dateC_ Then Exit Property
dateC_ = newDate
If Me.ActiveControl Is txt_C Then
' dateA = dateC_
' dateB = dateA_ + 3
' dateD = dateA_ + 7
Else
Call SwcFmt(txt_C, dateC, DATE_FMT1)
End If
End Property
Private Property Get dateD() As Date
dateD = dateD_
End Property
Private Property Let dateD(newDate As Date)
If newDate = dateD_ Then Exit Property
dateD_ = newDate
If Me.ActiveControl Is txt_D Then
' dateA = dateD_ - 7
' dateB = dateA_ + 3
' dateC = dateA_ + 0
Else
Call SwcFmt(txt_D, dateD, DATE_FMT1)
End If
End Property
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_A_Enter()
Call SwcFmt(txt_A, dateA, DATE_FMT2)
End Sub
Private Sub txt_A_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_A, dateA, DATE_FMT1)
End Sub
Private Sub txt_A_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_A_Change()
If EventOff Then Exit Sub
dateA = RtnDate(txt_A, dateA)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_B_Enter()
Call SwcFmt(txt_B, dateB, DATE_FMT2)
End Sub
Private Sub txt_B_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_B, dateB, DATE_FMT1)
End Sub
Private Sub txt_B_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_B_Change()
If EventOff Then Exit Sub
dateB = RtnDate(txt_B, dateB)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_C_Enter()
Call SwcFmt(txt_C, dateC, DATE_FMT2)
End Sub
Private Sub txt_C_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_C, dateC, DATE_FMT1)
End Sub
Private Sub txt_C_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_C_Change()
If EventOff Then Exit Sub
dateC = RtnDate(txt_C, dateC)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub txt_D_Enter()
Call SwcFmt(txt_D, dateD, DATE_FMT2)
End Sub
Private Sub txt_D_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call SwcFmt(txt_D, dateD, DATE_FMT1)
End Sub
Private Sub txt_D_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Call RtnKeyPress(KeyAscii)
End Sub
Private Sub txt_D_Change()
If EventOff Then Exit Sub
dateD = RtnDate(txt_D, dateD)
End Sub
Rem ------------------------------------------------------------------------------------------------
Private Sub SwcFmt(ByVal tb As MSForms.TextBox, d As Date, fmt As String)
EventOff = True
tb.Text = Format$(d, fmt)
EventOff = False
Debug.Print Timer, "SwcFmt "; tb.Name, tb.Text
End Sub
Private Sub RtnKeyPress(ByVal key As MSForms.ReturnInteger)
Select Case key.Value
Case Asc("0") To Asc("9"):
Case Else: key.Value = 0
End Select
End Sub
Private Function RtnDate(ByVal tb As MSForms.TextBox, d As Date) As Date
RtnDate = d
If tb.TextLength = 8 Then
Dim tmp As String
tmp = Format$(tb.Text, "0000/00/00")
If IsDate(tmp) Then RtnDate = CDate(tmp)
End If
End Function
Rem ------------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
dateA = Date
dateB = Date + 3
dateC = Date
dateD = Date + 7
End Sub
（白茶） 2022/11/30(水) 20:16:00
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.