請高手指點一下,如何做出動態的行事曆及雙擊選擇輸入的功能?
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 2# eigen
試試看- Option Explicit
- '工作表模組:雙擊儲存格程式
- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
- Ex Target.Cells(1), Target.Parent
- Target.Select
- End Sub
- Private Sub Ex(Rng As Range, sh As Worksheet)
- Dim T_Date, T_Mon As Integer, TE As Date
- Dim M As Integer, Week_Ar(), I As Integer
- Week_Ar = Array("日", "一", "二", "三", "四", "五", "六")
- Do Until IsDate(T_Date)
- T_Date = InputBox("請指定日期", , Date)
- If T_Date = "" Then Exit Sub
- Loop
- With sh
- .Cells.Clear '清除工作表
- .Cells.HorizontalAlignment = xlCenter '儲存格物件的水平對齊模式:置中
- .Cells.VerticalAlignment = xlCenter '儲存格物件的垂直對齊模式:置中
- End With
-
- With Rng.Resize(, 7) '指定日期的格式
- .Merge '合併: .Resize(, 7)
- .Font.Size = 30
- .Font.Bold = True
- .Font.Color = vbBlue
- .NumberFormatLocal = "yyyy-m-d"
- Rng = T_Date '日期
- End With
- I = I + 3
- For M = -1 To 1
- T_Date = DateAdd("M", M, Rng.Cells(1)) '取得指定月份的日期
- T_Date = DateSerial(Year(T_Date), Month(T_Date), 1) '指定月份日期的 1號開始
- T_Mon = Month(T_Date) '指定的月份
- With Rng.Cells(I).Resize(1, 7) '寫入 指定月份的格式
- .Merge
- .Cells = T_Date
- .NumberFormatLocal = "yyyy-m"
- .Font.Size = 15
- .Font.Bold = True
- .Font.Color = vbWhite
- .Interior.Color = vbBlue
- End With
- I = I + 1
- With Rng.Cells(I).Resize(, 7) '寫入星期的格式
- .Cells = Week_Ar
- .Interior.ColorIndex = 15
- .Range("A1,G1").Font.Color = vbRed
- End With
- I = I + 1
- Do While T_Mon = Month(T_Date) '迴圈的條件:同一個月份
- With Rng.Cells(I, Weekday(T_Date))
- .Cells = T_Date
- .NumberFormatLocal = "D"
- If Weekday(T_Date) = 1 Or Weekday(T_Date) = 7 Then .Font.Color = vbRed
- End With
- If Weekday(T_Date) = 7 And T_Mon = Month(T_Date + 1) Then I = I + 1
- T_Date = T_Date + 1 '日期加一天
- Loop
- I = I + 2
- Next
- End Sub
複製代碼 |
|
|
|
|
|
|
|