Excel VBA質問箱 IV

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

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


75276 / 76732 ←次へ | 前へ→

【5896】Re:コンボボックスに今日からの日付を入れる
回答  Hirofumi E-MAIL  - 03/6/7(土) 1:25 -

引用なし
パスワード
   cbo出発予定日は今日から3ヶ月間の日付
cbo帰宅予定日はcbo出発予定日から3ヶ月間の日付
が表示されます
cbo出発予定日、cbo帰宅予定日の値は曜日が入るため日付(シリアル値)として
認識されません
因って、ChangeDateTypeで行っているように"("以下を取り除いて
日付(シリアル値)とすることに注意して下さい

Option Explicit

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

Private Sub UserForm_Initialize()
  
  Dim i As Long
  Dim dtmFirst As Date
  Dim dtmEnd As Date
  
  dtmFirst = Date
  dtmEnd = DateAdd("m", 3, dtmFirst)
  
  With cbo出発予定日
    For i = dtmFirst To dtmEnd
      .AddItem Format(i, strDateForm)
    Next i
  End With
  
  cbo帰宅予定日.Enabled = False
  
End Sub

Private Sub cbo帰宅予定日_Change()

  TextBox1.Text = ChangeDateType(cbo帰宅予定日.Value) _
            - ChangeDateType(cbo出発予定日.Value)

End Sub

Private Sub cbo出発予定日_Change()

  Dim i As Long
  Dim dtmFirst As Date
  Dim dtmEnd As Date
  
  dtmFirst = ChangeDateType(cbo出発予定日.Value)
  dtmEnd = DateAdd("m", 3, dtmFirst)
  
  With cbo帰宅予定日
    .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 お礼

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