[[20221128133902]] 『ユーザーフォームのテキストボックスへ自動計算さ』(さとうとしお) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『ユーザーフォームのテキストボックスへ自動計算された日付を表示させたい』(さとうとしお)

ユーザーフォーム内にあるテキストボックスへ自動で計算した
日付を表示させたいので教えていただきたくお願いします。

【 】をユーザーフォームのテキストボックスと見立てています。

(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

MKさま
ありがとうございました。

 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.