Excel VBA質問箱 IV

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

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


75258 / 76732 ←次へ | 前へ→

【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

0 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 お礼

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