Excel VBA質問箱 IV

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

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


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

75264 / 76738

←次へ　｜　前へ→


	【5916】Re:カレンダーフォームによる別解

角田

- 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

2 hits

▼

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