Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


75274 / 76738 ←次へ | 前へ→

【5904】Re:コンボボックスに今日からの日付を入れる
質問  経理課支払担当  - 03/6/7(土) 14:22 -

引用なし
パスワード
   3月に投稿したことがあるのですが、その時私の投稿に答えて
くださった方ですね。
また私の投稿にお答えいただきありがとうございます。
で、今回の投稿のお答えに早速試してみたのですが、
comboboxに日付がぜんぜん入っておらず、うまくいきません。
Userform1の中にComboBox1、ComboBox2、TextBox1しか貼り付けていません。
おかしな所があったらご指摘お願いします。

Option Explicit

Const strDateForm As String = "yyyy年m月d日(aaa)"

Private Sub UserForm1_Initialize()
 
  Dim i As Long
  Dim dtmFirst As Date
  Dim dtmEnd As Date
 
  dtmFirst = Date
  dtmEnd = DateAdd("m", 3, dtmFirst)
 
  With ComboBox1
    For i = dtmFirst To dtmEnd
      .AddItem Format(i, strDateForm)
    Next i
  End With
 
  ComboBox2.Enabled = False
 
End Sub

Private Sub ComboBox2_Change()

  TextBox1.Text = ChangeDateType(ComboBox2.Value) _
            - ChangeDateType(ComboBox1.Value)

End Sub

Private Sub ComboBox1_Change()

  Dim i As Long
  Dim dtmFirst As Date
  Dim dtmEnd As Date
 
  dtmFirst = ChangeDateType(ComboBox1.Value)
  dtmEnd = DateAdd("m", 3, dtmFirst)
 
  With ComboBox2
    .Enabled = True
    .Clear
    For i = dtmFirst To dtmEnd
      .AddItem Format(i, strDateForm)
    Next i
  End With
 
End Sub

Private Function ChangeDateType(strValue As String) As Date

  Dim lngPos As Long
 
  If strValue <> "" Then
    lngPos = InStr(1, strValue, "(", vbBinaryCompare)
    ChangeDateType = CDate(Left(strValue, lngPos - 1))
  End If
 
End Function
1 hits

【5893】コンボボックスに今日からの日付を入れる 経理課支払担当 03/6/6(金) 19:23 質問
【5896】Re:コンボボックスに今日からの日付を入れる Hirofumi 03/6/7(土) 1:25 回答
【5904】Re:コンボボックスに今日からの日付を入れる 経理課支払担当 03/6/7(土) 14:22 質問
【5910】Re:コンボボックスに今日からの日付を入れる Hirofumi 03/6/7(土) 18:52 回答
【5914】Re:コンボボックスに今日からの日付を入れる 経理課支払担当 03/6/7(土) 22:45 質問
【5915】Re:コンボボックスに今日からの日付を入れる Hirofumi 03/6/7(土) 23:21 回答
【5923】Re:コンボボックスに今日からの日付を入れる 経理課支払担当 03/6/9(月) 17:51 お礼
【5916】Re:カレンダーフォームによる別解 角田 03/6/9(月) 14:20 回答
【5940】Re:カレンダーフォームによる別解 経理課支払担当 03/6/10(火) 15:26 お礼

75274 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free