返回列表 上一主題 發帖

日期選項同一週

zamamilo

帖子
26 
主題
14 
精華
0 
積分
71 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-30 
最後登錄
2023-11-6 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2012-5-21 12:14 | 只看該作者

日期選項同一週

各各高手大大,

  如附件,
1.點紅色這欄時出現日期選擇對話框供選擇,如日期不是
星期六時,出現對話框告知。
2.點黃色的任一儲存格時,一樣出現日期選擇功能,但如果不是
選擇和紅色日期同一週時,出現對話框告知
以上
懇請大大協助

TEST.rar (15.79 KB)

收藏 分享

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
277  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-12-23 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2012-5-21 22:03 | 只看該作者
回復 1# zamamilo
  1. Private Sub Calendar1_Click()
  2. If ActiveCell.Address = "$I$5" Then
  3.   If Weekday(Calendar1.Value, 2) <> 6 Then MsgBox "日期非星期六"
  4.   [I5] = Calendar1
  5.   Calendar1.Visible = False
  6.   ElseIf Not Intersect(ActiveCell, [B76:B81]) Is Nothing Then
  7.   If IsDate([I5]) Then
  8.   s = [I5] - Weekday([I5], 2)
  9.   If Calendar1 < s Or Calendar1 > s + 6 Then _
  10.   MsgBox "日期未在一星期之中" Else _
  11.   ActiveCell = Calendar1: Calendar1.Visible = False
  12.   Else
  13.    Exit Sub
  14.   End If
  15. End If
  16. End Sub

  18. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  19. If Intersect(Target, Union([I5], [B76:B81])) Is Nothing Then Calendar1.Visible = False: Exit Sub
  20. With Calendar1
  21. .Top = Target.Top
  22. .Left = Target.Offset(, 1).Left
  23. .Visible = True
  24. End With
  25. End Sub
複製代碼
日期.zip (22.19 KB)
學海無涯_不恥下問

TOP

        靜思自在 : 受人點水之恩，須當湧泉以報。
返回列表 上一主題