Board logo

標題: 怎麼才能在萬年曆上增加時間 [打印本頁]
作者: Jared    時間: 2014-4-16 16:06     標題: 怎麼才能在萬年曆上增加時間

想請問大大
如果我希望萬年曆上面，能夠增加時間的欄位
程式的部分要怎麼添加上去
好像加在哪裡都不對
[attach]18039[/attach]　[attach]18040[/attach]

目前只有顯示日期　2014/01/01
要怎麼樣才能顯示    2014/01/01  12:00

如果沒有填寫完畢 會提示時間欄位沒有填寫完成
測試檔案 [attach]18041[/attach]

希望有大大可以解決我的疑問
我這裡也會繼續測試看看，感激不盡！
作者: GBKEE    時間: 2014-4-17 08:53

回復 1# Jared


  [attach]18057[/attach]
  1. Private Sub 萬年曆()
  2.     Dim OBtop As Integer, OBLeft As Integer, R As Integer, W As Integer, i As Date
  3.         R = Label1.Top + 30
  4.           ReDim F_OB(1 To Day(DateSerial(ComboBox1, ComboBox2.Value + 1, 0)))
  5.           For i = DateSerial(ComboBox1, ComboBox2, 1) To DateSerial(ComboBox1, ComboBox2.Value + 1, 0) '年月1日到31日
  6.         W = Weekday(i) '位置
  7.         'With包覆程式為天數運算
  8.         With Controls.Add("Forms.OptionButton.1", i) 'Controls為控制項；OptionButton為單選紐
  9.             .Visible = True
  10.             .ControlTipText = i
  11.             .Top = R '最上面那排
  12.             .Left = Controls("Label" & W).Left '第一行呈現位置
  13.             .Height = 15      '高度
  14.             .Width = 30       '寬度
  15.             .Caption = Day(i) '計算當月最後一天天數
  16.         End With
  17.         Set F_OB(Day(i)).OB = Controls(i & "") '& c  '單選紐會彈跳出訊息
  18.         If Weekday(i) = 7 And Month(i) = Month(i + 1) Then
  19.             R = R + 30 '當位置等於7,R就加30   '** 備註 要考慮到同月份至少還有一天 **
  20.         End If
  21.      Next
  22.        Me.Frame1.Top = R + 30             '調整 時間的位置
  23.        Me.Height = R + Frame1.Height + 60 '調整 表單的高度
  24. End Sub
複製代碼
  1. Option Explicit
  2. Public WithEvents OB As MSForms.OptionButton
  3. Private Sub OB_Click()
  4.     Dim h As String, m As String
  5.     With UserForm1
  6.         h = "00 時 "
  7.         m = "00 分 "
  8.         With .TextBox1
  9.             If Val(.Text) >= 0 And Val(.Text) <= 24 Then h = Format(Val(.Text), "00 時 ")
  10.         End With
  11.         With .TextBox2
  12.             If Val(.Text) >= 0 And Val(.Text) <= 60 Then m = Format(Val(.Text), "00 分")
  13.         End With
  14.         test.TextBox1.Value = OB.ControlTipText & " " & h & m
  15.         .Hide
  16.     End With
  17. End Sub
複製代碼
作者: Jared    時間: 2014-4-17 10:36

回復 2# GBKEE


感謝大大的協助
我再測試看看

另外，我昨天下午有寫另外一個版本
若是沒有填寫時間
則會出現警告提示
點選（時）會清除日期選擇並填上『00』分

勉強可以使用
但我想應該還有更好的方式
[attach]18059[/attach]
再次感謝大大
希望自己能再更上一層( ^^ )
作者: GBKEE    時間: 2014-4-17 11:28

回復 3# Jared
另可使 OptionButton 不可用
  1. Option Explicit
  2. Public WithEvents OB As MSForms.OptionButton
  3. Public WithEvents Tx As MSForms.TextBox
  4. 'UserForm_Initialize 中設立 TextBox1,TextBox2
  5. Private Sub Tx_Change()
  6.     Dim Msg As Boolean, E As Control
  7.     With Tx
  8.         If IsNumeric(.Text) Then
  9.             If Tx.Name = "TextBox1" Then
  10.                 If Val(.Text) > 0 And Val(.Text) <= 24 Then Msg = True
  11.             ElseIf Tx.Name = "TextBox2" Then
  12.                 If Val(.Text) > 0 And Val(.Text) <= 60 Then Msg = True
  13.             End If
  14.         End If
  15.     End With
  16.     For Each E In Tx.Parent.Controls
  17.         If TypeName(E) = "OptionButton" Then E.Enabled = Msg
  18.     Next
  19. End Sub
複製代碼
作者: Hsieh    時間: 2014-4-17 23:39

本帖最後由 Hsieh 於 2014-4-17 23:55 編輯

回復 1# Jared
物件類別模組中
  1. Private Sub OB_Click()
  2.      test.TextBox1.Value = OB.ControlTipText & " " & UserForm1.TextBox1.Text & ":" & UserForm1.TextBox2.Text
  3.      Unload UserForm1
  4. End Sub
複製代碼
UserForm1模組中
  1. Private Sub UserForm_Initialize()
  2.     Dim i As Integer, hm$
  3.     For i = 2013 To 2020
  4.         ComboBox1.AddItem i
  5.     Next
  6.     ComboBox1.Value = Year(Date)
  7.     For i = 1 To 12
  8.         ComboBox2.AddItem i
  9.     Next
  10.     ComboBox2.Value = Month(Date)
  11.     hm = Format(Now, "hh:mm")
  12.     TextBox1.Text = Split(hm, ":")(0)
  13.     TextBox2.Text = Split(hm, ":")(1)
  14. End Sub
複製代碼
作者: Jared    時間: 2014-4-22 10:52

回復 4# GBKEE


感謝大大的回覆！
但是如果改成這樣，就沒辦法把想要的日期跟時間傳送到空白欄位了(@@)
作者: Jared    時間: 2014-4-22 11:00

回復 5# Hsieh


  謝謝大大！我都沒想到可以抓取系統時間
  學到一招了~ ^^



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