Board logo

標題: [發問] 日曆控制項如何設置成，在[目前儲存格]寫入指定日曆的日期? [打印本頁]
作者: jackson7015    時間: 2014-8-28 17:00     標題: 日曆控制項如何設置成，在[目前儲存格]寫入指定日曆的日期?

想請問各位前輩
日曆控制項如何將目前儲存格寫入，選取日曆後的日期?

目前連指定儲存格寫入日期都寫不出來...
作者: luhpro    時間: 2014-8-28 23:01

本帖最後由 luhpro 於 2014-8-28 23:18 編輯
想請問各位前輩
日曆控制項如何將目前儲存格寫入，選取日曆後的日期?
目前連指定儲存格寫入日期都寫不出 ...
jackson7015 發表於 2014-8-28 17:00

我拿我以前寫好的程式碼來改:
月曆控制項 : mvDate
清除日期按鈕   : cbClrDate

執行方式:
1. 對 [A1] 儲存格按滑鼠右鍵, 啟動 月曆控制項 與 清除日期按鈕.
    2-1. 若此時點擊 清除日期按鈕 會清空 目前儲存格, 然後隱藏 控制項 與 按鈕.
    2-2. 若此時在 月曆控制項 點擊任一日期, 會將該日期設定到 目前儲存格, 然後隱藏 控制項 與 按鈕.

以下程式碼放在 Sheets("工作表1") (月曆控制項 與 清除日期按鈕 都放在此工作表內)
  1. Private Sub mvDate_DateClick(ByVal DateClicked As Date)
  2.   rTar = DateClicked ' 設定日期到 目前儲存格
  3.   mvDate.Visible = False ' 隱藏日曆表
  4.   cbClrDate.Visible = False ' 隱藏清除日期鈕
  5. End Sub

  7. Private Sub cbClrDate_Click()
  8.   rTar = "" ' 清空 目前儲存格
  9.   mvDate.Visible = False
  10.   cbClrDate.Visible = False
  11. End Sub

  13. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  14.   With Target
  15.     If .Row = 1 And .Column = 1 Then ' 對 [A1} 儲存格按滑鼠右鍵
  16.       mvOpenDate.Visible = True ' 顯示日曆表
  17.       cbClearDate.Visible = True ' 顯示清除日期鈕
  18.       Cancel = True ' 不繼續執行原先按滑鼠右鍵會執行的功能
  19.       Exit Sub
  20.     End If
  21.   End With
  22. End Sub

  24. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  25.     Set rTar = Target ' 設定 rTar 為 目前儲存格
  26. End Sub
複製代碼
以下程式碼放在 ThisWorkBook :
  1. Private Sub Workbook_Open()
  2.   With Sheets("工作表1")
  3.     rTar = ""
  4.     With .mvDate
  5.       .Visible = True ' 顯示日曆表
  6.       .Value = Date ' 設定預設值為今天
  7.       .Visible = False ' 隱藏日曆表
  8.     End With
  9.     .cbClrDate.Visible = False ' 隱藏清除日期鈕
  10.   End With
  11. End Sub
複製代碼
以下程式碼放在 Module :
  1. Public rTar As Range
  2. Option Explicit
複製代碼
作者: jackson7015    時間: 2014-8-29 16:09

回復 2# luhpro
感謝luhpro大大的幫忙

因為自己電腦終沒有Access，所以我的月曆控制項目是另外載入的，來源則是由2007中取出的
宣告模組是DTPicker1_CallbackKeyDown
所以不曉得怎麼編寫

因為控制項目內沒有月曆控制項和清除日期按鈕   
帶入大大提供的公式，執行程序沒有反應
而使用網路上其他類似的編寫，也是有錯誤

不曉得是否有其他前備有類似經驗
作者: luhpro    時間: 2014-8-30 09:20

本帖最後由 luhpro 於 2014-8-30 09:27 編輯

回復 3# jackson7015
試試看:

cbClrDate : 清除日期按鈕
dtpDate : 日曆表

以下程式碼放在 ThisWorkBook :
  1. Private Sub Workbook_Open()
  2.   With Sheets("工作表1")
  3.     Set rTar = [A2]
  4.     With .dtpDate
  5.       .Visible = True ' 顯示日曆表
  6.       .Value = Date ' 設定預設值為今天
  7.       .Visible = False ' 隱藏日曆表
  8.     End With
  9.     .cbClrDate.Visible = False ' 隱藏清除日期鈕
  10.   End With
  11. End Sub
複製代碼
以下程式碼放在 Module :
  1. Public rTar As Range

  3. Option Explicit
複製代碼
以下程式碼放在 Sheets("工作表1") (月曆控制項 與 清除日期按鈕 都放在此工作表內) :
  1. Private Sub dtpDate_Change()
  2.   SetDate
  3. End Sub

  5. Private Sub dtpDate_CloseUp()
  6.   SetDate
  7. End Sub

  9. Private Sub cbClrDate_Click()
  10.   rTar = "" ' 清空 目前儲存格
  11.   dtpDate.Visible = False
  12.   cbClrDate.Visible = False
  13. End Sub

  15. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
  16.   With Target
  17.     If .Row = 1 And .Column = 1 Then ' 對 [A1} 儲存格按滑鼠右鍵
  18.       dtpDate.Visible = True ' 顯示日曆表
  19.       cbClrDate.Visible = True ' 顯示清除日期鈕
  20.       Cancel = True ' 不繼續執行原先按滑鼠右鍵會執行的功能
  21.       Exit Sub
  22.     End If
  23.   End With
  24. End Sub

  26. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  27.   With Target
  28.    If .Row <> 1 And .Column <> 1 Then
  29.      Set rTar = Target ' 設定 rTar 為 目前儲存格
  30.    End If
  31.   End With
  32. End Sub

  34. Private Sub SetDate()
  35.   With rTar
  36.     .Value = dtpDate ' 設定日期到 目前儲存格
  37.     .NumberFormat = "yyyy/m/d;@"
  38.   End With
  39.   cbClrDate.Visible = False ' 隱藏清除日期鈕
  40.   dtpDate.Visible = False ' 隱藏日曆表
  41. End Sub
複製代碼
附註 :  以上程式不能適用於 A1 儲存格

另上方  #2 程式碼有誤 :
行 16 與 17 應改為
  1. mvDate.Visible = True ' 顯示日曆表
  2. cbClrDate.Visible = True ' 顯示清除日期鈕
複製代碼
作者: starry1314    時間: 2015-5-18 17:30

回復 4# luhpro


   大大請問如果使用２０１３要使用什麼嗎？
使用此程式碼沒有反應。。。對ａ１右鍵也無反應。。。
作者: starry1314    時間: 2015-5-18 23:45

回復 4# luhpro


    已解決...



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)