Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13327 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 お礼
【5893】コンボボックスに今日からの日付を入れる
質問  経理課支払担当  - 03/6/6(金) 19:23 -
引用なし
パスワード
   userformの中に、
出発予定日を選択するコンボボックスと
帰宅予定日を選択するコンボボックスがあります。

エクセルシートで、選択した出発予定日と帰宅予定日を表示し、
その選択した値から何泊何日になるか表示したいです。
何泊何日はuserformにのせなくていいです。

他に条件は、
・コンボボックスに格納する日付は今日から3ヶ月後までの日付すべて
・コンボボックス、エクセルシートでの日付の表示形式　例：2003年6月6日（金）

よろしくお願いします。
【5896】Re:コンボボックスに今日からの日付を入れ...
回答  Hirofumi E-MAIL  - 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
【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
【5910】Re:コンボボックスに今日からの日付を入れ...
回答  Hirofumi E-MAIL  - 03/6/7(土) 18:52 -
引用なし
パスワード
   >comboboxに日付がぜんぜん入っておらず、うまくいきません。
>Userform1の中にComboBox1、ComboBox2、TextBox1しか貼り付けていません。
>おかしな所があったらご指摘お願いします。

１点有ります以下の様に成っていますが

>Private Sub UserForm1_Initialize()

此れは、UserFormのInitializeなので1が要りません
VBE（VBAのエディタ）でUserFormのInitializeイベントを選ぶと
以下の様になるでしょ

Private Sub UserForm_Initialize()

この様にすれば動くと思います
尚、今回、ComboBoxのEnabledプロパティを使うので、
ComboBoxのイベントをChangeで書いています
しかし、場合によっては、違うイベントを考慮した方が善い時も在りますので
気をつけて下さい
また、Enabledが必要無ければ削除して下さい
【5914】Re:コンボボックスに今日からの日付を入れ...
質問  経理課支払担当  - 03/6/7(土) 22:45 -
引用なし
パスワード
   >Private Sub UserForm_Initialize()
すみません・・・単純な間違いをおかしてしまいました。

また質問をしてしまいますが、

出発予定日を選択しました、
帰宅予定日を選択しました、
あ、出発予定日を間違えたので選択し直す・・・
ということをして、泊数と日数を見るとマイナスの日数になっています。
マイナスの日数を表示させないようにするにはどうしたら
よいですか？
必死で考えたんですけどうまくいきませんでした。

とりあえずマイナスの日数はほっておいて帰宅予定日を選択すれば、
きちんと表示されますが・・・細かくてすみません。
【5915】Re:コンボボックスに今日からの日付を入れ...
回答  Hirofumi E-MAIL  - 03/6/7(土) 23:21 -
引用なし
パスワード
   ゴメンナサイ､泊数は本来要らないと思って適当に書いてありました
以下の様に修正して下さい

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 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
　　TextBox1.Text = ""
　　
End Sub

の様に
【5916】Re:カレンダーフォームによる別解
回答  角田 WEB  - 03/6/9(月) 14:20 -
引用なし
パスワード
   こんにちは。
別解をひとつ‥‥‥
出発日(Ｂ列)/帰宅日(Ｃ列)のセルをダブルクリックすると､カレンダーフォーム
がポップアップして日付入力するという例です。

----- シートモジュール ------
Private Sub Worksheet_BeforeDoubleClick _
　　 (ByVal Target As Range, Cancel As Boolean)
Dim MyDate As Date
Dim dtmFromDate As Date
Dim dtmToDate As Date
If (Target.Row <= 1) Then
　Exit Sub　　　　'タイトル行
Else
　Select Case Target.Column
　　Case 2　　'出発日(Ｂ列)
　　　dtmFromDate = DateSerial(Year(Date), Month(Date), 1)
　　　dtmToDate = DateSerial(Year(Date), Month(Date) + 4, 0)
　　　If ktCalDate(MyDate, Target.Value, 入力Msg:="出発日", _
　　　　　　　　　 期間制限Fr:=dtmFromDate, 期間制限To:=dtmToDate) Then
　　　　Target.Value = MyDate
　　　　'Target.Value = Format(MyDate, "yyyy/m/d")
　　　　If (Target.Offset(0, 1).Value < MyDate) Then
　　　　　'既入力の帰宅日の方が過去ならばクリア
　　　　　Target.Offset(0, 1).ClearContents
　　　　End If
　　　End If
　　　Cancel = True
　　Case 3　　'帰宅日(Ｃ列)
　　　If (Target.Offset(0, -1).Value = "") Then
　　　　Beep　'出発日未入力
　　　Else
　　　　dtmFromDate = Target.Offset(0, -1).Value
　　　　dtmToDate = DateSerial(Year(dtmFromDate),Month(dtmFromDate)+4,0)
　　　　If ktCalDate(MyDate, Target.Value, 入力Msg:="帰宅日", _
　　　　　　　　　　 期間制限Fr:=dtmFromDate, 期間制限To:=dtmToDate) Then
　　　　　Target.Value = MyDate
　　　　　'Target.Value = Format(MyDate, "yyyy/m/d")
　　　　End If
　　　End If
　　　Cancel = True
　　Case Else
　　　Exit Sub
　End Select
End If
End Sub
------------------------------------
[kt関数アドイン]というσ(^_^)のアドインソフトにある[ktCalDate]
というカレンダー入力フォームを使った例です。
ＤＬはσ(^_^)のＨＰから出来ます。

日付入力用のツールは他にも色々とあります。
「カレンダーコントロール色々」
http://www.h3.dion.ne.jp/~sakatsu/Excel_Tips06.htm
【5923】Re:コンボボックスに今日からの日付を入れ...
お礼  経理課支払担当  - 03/6/9(月) 17:51 -
引用なし
パスワード
   解決しました。
ありがとうございました。
【5940】Re:カレンダーフォームによる別解
お礼  経理課支払担当  - 03/6/10(火) 15:26 -
引用なし
パスワード
   別解ありがとうございます！
早速試してみました。
カレンダーというコントロールが存在するんですね。
初めて知りました（初心者なもので・・・）。
こちらも、何かに利用してみようかなと思います。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
13327 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free