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出発予定日は今日から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

【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しか貼り付けていません。
>おかしな所があったらご指摘お願いします。

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

>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 -

引用なし
パスワード
   こんにちは。
別解をひとつ‥‥‥
出発日(B列)/帰宅日(C列)のセルをダブルクリックすると、カレンダーフォーム
がポップアップして日付入力するという例です。

----- シートモジュール ------
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  '出発日(B列)
   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  '帰宅日(C列)
   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]
というカレンダー入力フォームを使った例です。
DLはσ(^_^)のHPから出来ます。

日付入力用のツールは他にも色々とあります。
「カレンダーコントロール色々」
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