Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

75282 / 76738

←次へ　｜　前へ→


	【5896】Re:コンボボックスに今日からの日付を入れる

Hirofumi

- 03/6/7(土) 1:25 -


	引用なし

	パスワード

cbo出発予定日は今日から３ヶ月間の日付
cbo帰宅予定日はcbo出発予定日から３ヶ月間の日付
が表示されます
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

0 hits

▼

【5893】コンボボックスに今日からの日付を入れる 経理課支払担当 03/6/6(金) 19:23