返回列表 上一主題 發帖

[發問] 能否幫我看看如何將此程式更改成以 小時 分鐘 秒數 計算(已解決)

本帖最後由 GBKEE 於 2011-5-13 11:22 編輯

回復 1# vpower
  1. Private Sub CommandButton1_Click()
  2.     Dim TheDay#, Msg$, J1%, S$, D$, H$
  3.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  4.         TheDay = Now - Range("C" & J1).Value: Msg = " 時間 已過"
  5.         If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間 還有"
  6.         H = IIf(Abs(Int(TheDay)) > 0, Abs(Int(TheDay)) & "天", "") & Format(TheDay, "hh小時:mm分鐘:ss秒")
  7.         H = Replace(Replace(H, "00小時:", ""), "00分鐘:", "")
  8.         S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & H
  9.     Next
  10.     If S <> "" Then MsgBox S, , Format(Now, "dddddd ttttt")
  11. End Sub
複製代碼

TOP

回復 3# vpower
那是多餘的,可刪掉.
  1. Private Sub CommandButton1_Click()
  2.     Dim TheDay#, Msg$, J1%, S$, H$
  3.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  4.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  5.             TheDay = Now - Range("C" & J1).Value: Msg = " 時間 已過"
  6.             If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間 還有"
  7.             H = IIf(Abs(Int(TheDay)) > 0, Abs(Int(TheDay)) & "天", "") & Format(TheDay, "hh小時:mm分鐘:ss秒")
  8.             H = Replace(Replace(Replace(H, "00小時:", ""), "00分鐘:", ""), ":00秒", "")
  9.             S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & H
  10.         End If
  11.     Next
  12.     If S <> "" Then MsgBox S, , Format(Now, "dddddd ttttt")
  13. End Sub
複製代碼

TOP

回復 5# vpower
  1. Private Sub Workbook_Open()
  2.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  3.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  4.         ''''''''''''''''''''''''''''''''''''''''''''''''
  5.             I1 = DateDiff("D", Date, Range("C" & J1))
  6.             If I1 < 0 Then S1 = "的時間已經到了" & (-1) * (I1) & "天"
  7.             If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & S1 & vbNewLine
  8.             S1 = "": I1 = 0
  9.         '''''''''''''''''''''''''''''''''''''''''''
  10.         End If
  11.     Next
  12.     If S2 <> "" Then MsgBox S2
  13.     S2 = ""
  14. End Sub
複製代碼
  1. Sub 提醒()
  2.     Dim TheTime, TheTimeMsg$, Msg As Boolean
  3.     With Sheets("Sheet1")
  4.         For J1 = 2 To .[C65536].End(xlUp).Row
  5.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then If Range("C" & J1) > Now Then Msg = True
  6.         Next
  7.         If Msg = False Then MsgBox "所有事件皆已過時!!", , "提醒": Exit Sub
  8.         Do
  9.             TheTime = Application.InputBox("輸入提醒分鐘", "提醒", , Msg)
  10.             If TheTime = "" Then Exit Sub
  11.             TheTimeMsg = TheTime
  12.         Loop Until TheTime >= 1 And TheTime <= 60
  13.         For J1 = 2 To .[C65536].End(xlUp).Row
  14.             If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  15.                 If Range("C" & J1) - TimeValue("00:" & TheTime) > Now Then
  16.                 Msg = True
  17.                '二選一
  18.                 Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "Sheet1.CommandButton1_Click"
  19.                 'Sheet1.CommandButton1_Click  程式碼放在 Sheet1
  20.                  
  21.                 'Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "ThisWorkbook.Workbook_Open"
  22.                 'ThisWorkbook.Workbook_Open 程式碼放在 ThisWorkbook               
  23.                 End If
  24.             End If
  25.         Next
  26.     End With
  27. End Sub
複製代碼

TOP

回復 8# vpower

    測試.rar (28.62 KB)

試試看看 開檔後有錯誤時請修改 下列程式的 播放音樂檔案
  1. Private Sub Workbook_Open()
  2.        '
  3.        '
  4.     With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  5.        .URL = "d:\愛的路上我和你.mp3"  '請修改音樂檔案
  6.         .Visible = False
  7.         .Controls.Stop
  8.     End With
  9.     事件提醒          '自動於時間到提醒
  10.     If S2 <> "" Then MsgBox S2
  11. End Sub
複製代碼

TOP

回復 10# vpower
我是2003版 在使用表單中 WindowsMediaPlayer 第一次會有系統的警示提問,
所以我改用工作表插入物件的 WindowsMediaPlayer ,
如圖

你在表單加入 WindowsMediaPlayer 控制項,須修改表單的程式碼將Sheet1. 刪掉
Private Sub UserForm_Initialize()
    With Sheet1.WindowsMediaPlayer1
       .URL = "d:\愛的路上我和你.mp3"  '請修改檔案
        '.Visible = False
        .Controls.Play
    End With
    事件
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Sheet1.WindowsMediaPlayer1.Controls.Stop
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Workbook_Open()
'
'
'''''''你用的是表單的 WindowsMediaPlayer 控制項''''''''''''''
''''''''Workbook_Open這一段就不需用了''''''''''''''
    With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
       .URL = "d:\愛的路上我和你.mp3"  '請修改音樂檔案
        .Visible = False
        .Controls.Stop
    End With
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    事件提醒          '自動於時間到提醒
    If S2 <> "" Then MsgBox S2
End Sub

TOP

本帖最後由 GBKEE 於 2011-5-15 13:15 編輯

回復 12# vpower
給你附檔 你無法視使用, 所以你改用表單的控制項WindowsMediaPlayer1 來測試,還是無法適用對嗎?
你改用表單WindowsMediaPlayer1的控制項,要修改UserForm 表單的程式碼部分如下
  1. Private Sub UserForm_Initialize()
  2.     With WindowsMediaPlayer1   ' -> 表單的WindowsMediaPlayer1
  3.        .URL = "d:\愛的路上我和你.mp3"  '請修改檔案
  4.         .Visible = False
  5.         .Controls.Play
  6.     End With
  7.     事件
  8. End Sub
  9. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  10.     WindowsMediaPlayer1.Controls.Stop   ' -> 表單的WindowsMediaPlayer1
  11. End Sub
複製代碼
'''''''你用的是表單的 WindowsMediaPlayer 控制項''''''''''''''
''''''''SUB Workbook_Open()的程式碼中  這一段就不需用了''''''''''''''
    With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
       .URL = "d:\愛的路上我和你.mp3"  '請修改音樂檔案
        .Visible = False
        .Controls.Stop
    End With

回復 12# vpower
先把11樓的問題 搞定!

TOP

回復 15# vpower
是這樣嗎?
  1. Private Sub Workbook_Open()
  2.     Dim J1%, S1$, S2$
  3.     With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  4.         .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  5.         .Visible = False
  6.         .Controls.stop
  7.     End With
  8.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  9.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  10.         ''''''''''''''''''''''''''''''''''''''''''''''''
  11.             I1 = DateDiff("D", Date, Range("C" & J1))
  12.             If I1 >= 0 And I1 <= 90 Then S1 = "在90天內過期"
  13.             If I1 <= 60 Then S1 = "在60天內過期"
  14.             If I1 <= 30 Then S1 = "在30天內過期"
  15.             If I1 < 0 Then S1 = "已過期" & (-1) * (I1) & "天"
  16.             If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & "-" & S1 & vbNewLine & vbNewLine
  17.             S1 = "": I1 = 0
  18.         '''''''''''''''''''''''''''''''''''''''''''
  19.         End If
  20.     Next
  21.     If S2 <> "" Then
  22.         With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  23.             .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  24.             .Visible = False
  25.             .Controls.Play          '播放音樂
  26.           ''''''''''''''''''''''''''''''''''''
  27.             MsgBox S2
  28.             .Controls.stop          '關閉音樂
  29.             '''''''''''''''''''''''''''''''''
  30.         End With
  31.     End If
  32.     'If S2 <> "" Then MsgBox S2 Else
  33. End Sub
複製代碼

TOP

回復 17# vpower
是這樣嗎!
  1. Private Sub CommandButton1_Click()
  2.     Dim TheDay#, Msg$, J1%, S$, Hh$, Mm$, Ss$
  3.     For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
  4.         If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
  5.             TheDay = Now - Range("C" & J1).Value: Msg = " 時間 已過"
  6.             If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間 還有"
  7.             If Abs(Int(TheDay)) > 0 Then
  8.               Mm = Format(Minute(TheDay), "00分鐘")
  9.               Ss = Format(Second(TheDay), "00秒")
  10.               Hh = Abs(Int(TheDay)) * 24 + Hour(TheDay) & "小時" + Mm + Ss
  11.             Else
  12.                 Hh = Format(TheDay, "hh小時mm分鐘ss秒")
  13.                 Hh = Replace(Hh, "00小時", "")
  14.             End If
  15.             Hh = Replace(Replace(Hh, "00分鐘", ""), "00秒", "")
  16.             S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & Hh
  17.         End If
  18.     Next
  19.     If S <> "" Then
  20.         With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  21.             .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  22.             .Visible = False
  23.             .Controls.Play          '播放音樂
  24.             MsgBox S
  25.             .Controls.Stop          '關閉音樂
  26.         End With
  27.     End If
  28. End Sub
複製代碼

TOP

回復 19# vpower
試試看對?

測試.rar (29 KB)

TOP

回復 21# vpower
1.為什麼我把時間欄全部刪除,他還是會播放音樂?點選市件查看的時候也會直接播放音樂  
不會的  S <> "" 才會播放音樂的 你有修改程式嗎?
  1. If S <> "" Then   
  2.         With Sheet1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
  3.            .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
  4.             .Visible = False
  5.             .Controls.Play          '播放音樂
  6.             MsgBox S
  7.             .Controls.Stop          '關閉音樂
  8.         End With
  9.     End If
複製代碼

2.關於設定時間?小時,分鐘,秒鐘以前那邊要如何移除再次確認訊息呢?
Private Sub CommandButton1_Click()    表單的程序碼 刪掉紅色部份
    If MsgBox("確定 ??", vbYesNo) = vbYes Then   提醒 True   
    Unload Me
End Sub

TOP

        靜思自在 : 【生命在呼吸間】佛陀說:「生命在呼吸間。」人無法管住自己的生命,更無法擋住死期,讓自己永住人間。既然生命去來這麼無常,我們更應該好好地愛惜它、利用它、充實它,讓這無常、寶貴的生命,散發它真善美的光輝,映照出生命真正的價值。
返回列表 上一主題