[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームのテキストボックスへ自動計算された日付を表示させたい』(さとうとしお)
ユーザーフォーム内にあるテキストボックスへ自動で計算した
日付を表示させたいので教えていただきたくお願いします。
【 】をユーザーフォームのテキストボックスと見立てています。
(1)車検【txt_A】から【txt_B】
(2)納車【txt_C】
(3)支払期日【txt_D】
やりたいこと---
txt_Aに西暦から日付を手入力する
入力と同時に以下の処理をしたい
↓
txt_Bにtxt_Aから3日後の日付が自動反映
↓
txt_Cにtxt_Aの日付が自動反映
↓
txt_Dにtxt_Aから7日後の日付が自動反映
コマンドボタンなどを使用せず、txt_Aに8ケタの数字が入力される→計算された日付が表示される、としたいです。
やりたいことここまで---
なぜ、テキストボックスにしているかというと、
上記ルール(何日後)はデフォルトで、9割はそのまま進みますが
表示日付より以降であれば日付は変えることができるためです。
他にも入力項目があるため、全て入力した後にコマンドボタン押下で
テキストボックスに入力の内容を転記させるようにする予定です。
よろしくお願いいたします。
< 使用 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_Aに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_A_Change()
Dim mydate As String Dim dateA As Date Dim dateB As Date Dim dateC As Date dateA = CDate(Format(txt_A, "@@@@/@@/@@")) dateB = DateAdd("d", 3, dateA) dateC = DateAdd("d", 7, dateA) txt_B = dateB txt_C = dateA txt_D = 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_Aは入力した後に変えることは出来ませんか?
(さとうとしお) 2022/11/30(水) 16:54:58
長いコードを書き込んでくださり大変ありがとうございます。
知らないことばかりで確認していたらお返事が遅くなってしまいました。
申し訳ありません。
まだ、どのコードでどのように動いているのかすべて見れていないのですが、
txt_Aに入力→エンターキー押下→txt_Bがアクティブになる→押下→日付が表示される
となり、それぞれのテキストボックス内でエンターキーを押下しないと日付が表示されないのは
どこを見ればいいですか?
希望はtxt_Aに入力→エンター→すべての日付が反映
(他の入力項目が非常に多く少しでも時短したい)
自動反映されたテイストボックスへ新たに日付を入力すると曜日も合わせて変わり、
こちらは求めていた機能でしたので非常にうれしいです。
ありがとうございます。
よろしくお願いいたします。
(さとうとしお) 2022/11/30(水) 17:06:49
> txt_Aに入力→エンターキー押下→txt_Bがアクティブになる→押下→日付が表示される > 希望はtxt_Aに入力→エンター→すべての日付が反映
えーと... よく分かりませんが ^^; とりあえず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.