返回列表 上一主題 發帖

請高手指點一下,如何做出動態的行事曆及雙擊選擇輸入的功能?

回復 2# eigen
試試看
  1. Option Explicit
  2. '工作表模組:雙擊儲存格程式
  3. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  4.     Ex Target.Cells(1), Target.Parent
  5.     Target.Select
  6. End Sub

  7. Private Sub Ex(Rng As Range, sh As Worksheet)
  8.     Dim T_Date, T_Mon As Integer, TE As Date
  9.     Dim M As Integer, Week_Ar(), I As Integer
  10.     Week_Ar = Array("日", "一", "二", "三", "四", "五", "六")
  11.     Do Until IsDate(T_Date)
  12.         T_Date = InputBox("請指定日期", , Date)
  13.         If T_Date = "" Then Exit Sub
  14.     Loop
  15.     With sh
  16.         .Cells.Clear                            '清除工作表
  17.         .Cells.HorizontalAlignment = xlCenter   '儲存格物件的水平對齊模式:置中
  18.         .Cells.VerticalAlignment = xlCenter     '儲存格物件的垂直對齊模式:置中
  19.     End With
  20.    
  21.     With Rng.Resize(, 7)                        '指定日期的格式
  22.         .Merge                                  '合併: .Resize(, 7)
  23.         .Font.Size = 30
  24.         .Font.Bold = True
  25.         .Font.Color = vbBlue
  26.         .NumberFormatLocal = "yyyy-m-d"
  27.          Rng = T_Date                           '日期
  28.     End With
  29.     I = I + 3
  30.     For M = -1 To 1
  31.         T_Date = DateAdd("M", M, Rng.Cells(1))                           '取得指定月份的日期
  32.         T_Date = DateSerial(Year(T_Date), Month(T_Date), 1)     '指定月份日期的 1號開始
  33.         T_Mon = Month(T_Date)                                   '指定的月份
  34.         With Rng.Cells(I).Resize(1, 7)                          '寫入 指定月份的格式
  35.             .Merge
  36.             .Cells = T_Date
  37.             .NumberFormatLocal = "yyyy-m"
  38.             .Font.Size = 15
  39.             .Font.Bold = True
  40.             .Font.Color = vbWhite
  41.             .Interior.Color = vbBlue
  42.         End With
  43.         I = I + 1
  44.         With Rng.Cells(I).Resize(, 7)                           '寫入星期的格式
  45.             .Cells = Week_Ar
  46.             .Interior.ColorIndex = 15
  47.             .Range("A1,G1").Font.Color = vbRed
  48.         End With
  49.         I = I + 1
  50.         Do While T_Mon = Month(T_Date)                          '迴圈的條件:同一個月份
  51.             With Rng.Cells(I, Weekday(T_Date))
  52.                 .Cells = T_Date
  53.                 .NumberFormatLocal = "D"
  54.                 If Weekday(T_Date) = 1 Or Weekday(T_Date) = 7 Then .Font.Color = vbRed
  55.             End With
  56.             If Weekday(T_Date) = 7 And T_Mon = Month(T_Date + 1) Then I = I + 1
  57.             T_Date = T_Date + 1                                 '日期加一天
  58.         Loop
  59.         I = I + 2
  60.     Next
  61. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# eigen
  1. '工作表模組:雙擊儲存格程式
  2. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  3.     Ex Target, Target.Parent
  4.     'Sub Ex 的程式碼中
  5.     'With Rng.Resize(, 7)    '日期的範圍
  6.     '   .Merge               '合併為儲存格
  7.     '*** -> Target.Resize(, 7)  合併為儲存格  ****
  8.     '***    原本的位置當你再次,雙擊儲存格,看看有何變化
  9. End Sub
複製代碼
這工作表函數落落長,眼力不好,有請眼力好者,幫幫忙.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 修行要繫緣修心,藉事練心,隨處養心。
返回列表 上一主題