麻辣家族討論版版 - Powered by Discuz! Board

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

作者: vpower 時間: 2011-5-12 22:35 標題: 能否幫我看看如何將此程式更改成以小時分鐘秒數計算(已解決)

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-13 11:19

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

回復 1# vpower

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

複製代碼

作者: vpower 時間: 2011-5-13 13:39

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-13 14:05

回復 3# vpower
那是多餘的,可刪掉.

Private Sub CommandButton1_Click()
Dim TheDay#, Msg$, J1%, S$, H$
For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
TheDay = Now - Range("C" & J1).Value: Msg = " 時間已過"
If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間還有"
H = IIf(Abs(Int(TheDay)) > 0, Abs(Int(TheDay)) & "天", "") & Format(TheDay, "hh小時:mm分鐘:ss秒")
H = Replace(Replace(Replace(H, "00小時:", ""), "00分鐘:", ""), ":00秒", "")
S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & H
End If
Next
If S <> "" Then MsgBox S, , Format(Now, "dddddd ttttt")
End Sub

複製代碼

作者: vpower 時間: 2011-5-13 21:25

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-14 09:45

回復 5# vpower

Private Sub Workbook_Open()
For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
''''''''''''''''''''''''''''''''''''''''''''''''
I1 = DateDiff("D", Date, Range("C" & J1))
If I1 < 0 Then S1 = "的時間已經到了" & (-1) * (I1) & "天"
If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & S1 & vbNewLine
S1 = "": I1 = 0
'''''''''''''''''''''''''''''''''''''''''''
End If
Next
If S2 <> "" Then MsgBox S2
S2 = ""
End Sub

複製代碼

Sub 提醒()
Dim TheTime, TheTimeMsg$, Msg As Boolean
With Sheets("Sheet1")
For J1 = 2 To .[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then If Range("C" & J1) > Now Then Msg = True
Next
If Msg = False Then MsgBox "所有事件皆已過時!!", , "提醒": Exit Sub
Do
TheTime = Application.InputBox("輸入提醒分鐘", "提醒", , Msg)
If TheTime = "" Then Exit Sub
TheTimeMsg = TheTime
Loop Until TheTime >= 1 And TheTime <= 60
For J1 = 2 To .[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
If Range("C" & J1) - TimeValue("00:" & TheTime) > Now Then
Msg = True
'二選一
Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "Sheet1.CommandButton1_Click"
'Sheet1.CommandButton1_Click 程式碼放在 Sheet1
'Application.OnTime Range("C" & J1) - TimeValue("00:" & TheTime), "ThisWorkbook.Workbook_Open"
'ThisWorkbook.Workbook_Open 程式碼放在 ThisWorkbook
End If
End If
Next
End With
End Sub

複製代碼

作者: vpower 時間: 2011-5-14 16:31

提示: 作者帳號被禁止或禁止訪問

作者: vpower 時間: 2011-5-14 16:54

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-14 21:19

回復 8# vpower

[attach]6183[/attach]

試試看看開檔後有錯誤時請修改下列程式的播放音樂檔案

Private Sub Workbook_Open()
'
'
With Sheet1.WindowsMediaPlayer1 '加入MediaPlayer播放音樂
.URL = "d:\愛的路上我和你.mp3" '請修改音樂檔案
.Visible = False
.Controls.Stop
End With
事件提醒 '自動於時間到提醒
If S2 <> "" Then MsgBox S2
End Sub

複製代碼

作者: vpower 時間: 2011-5-14 23:06

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-15 06:43

回復 10# vpower
我是2003版在使用表單中 WindowsMediaPlayer 第一次會有系統的警示提問,
所以我改用工作表插入物件的 WindowsMediaPlayer ,
如圖
[attach]6194[/attach]
你在表單加入 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

作者: vpower 時間: 2011-5-15 11:54

提示: 作者帳號被禁止或禁止訪問

作者: vpower 時間: 2011-5-15 12:17

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-15 13:13

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

回復 12# vpower
給你附檔你無法視使用, 所以你改用表單的控制項WindowsMediaPlayer1 來測試,還是無法適用對嗎?
你改用表單WindowsMediaPlayer1的控制項,要修改UserForm 表單的程式碼部分如下

Private Sub UserForm_Initialize()
With WindowsMediaPlayer1 ' -> 表單的WindowsMediaPlayer1
.URL = "d:\愛的路上我和你.mp3" '請修改檔案
.Visible = False
.Controls.Play
End With
事件
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
WindowsMediaPlayer1.Controls.Stop ' -> 表單的WindowsMediaPlayer1
End Sub

複製代碼

'''''''你用的是表單的 WindowsMediaPlayer 控制項''''''''''''''
''''''''SUB Workbook_Open()的程式碼中  這一段就不需用了''''''''''''''
With Sheet1.WindowsMediaPlayer1    '加入MediaPlayer播放音樂
   .URL = "d:\愛的路上我和你.mp3"  '請修改音樂檔案
      .Visible = False
      .Controls.Stop
End With

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

作者: vpower 時間: 2011-5-15 17:06

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-15 19:56

回復 15# vpower
是這樣嗎?

Private Sub Workbook_Open()
Dim J1%, S1$, S2$
With Sheet1.WindowsMediaPlayer1 '加入MediaPlayer播放音樂
.URL = "D:\數羊歌.MP3" '請修改音樂檔案
.Visible = False
.Controls.stop
End With
For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
''''''''''''''''''''''''''''''''''''''''''''''''
I1 = DateDiff("D", Date, Range("C" & J1))
If I1 >= 0 And I1 <= 90 Then S1 = "在90天內過期"
If I1 <= 60 Then S1 = "在60天內過期"
If I1 <= 30 Then S1 = "在30天內過期"
If I1 < 0 Then S1 = "已過期" & (-1) * (I1) & "天"
If S1 <> "" Then S2 = S2 & Sheets("Sheet1").Range("A" & J1) & "-" & S1 & vbNewLine & vbNewLine
S1 = "": I1 = 0
'''''''''''''''''''''''''''''''''''''''''''
End If
Next
If S2 <> "" Then
With Sheet1.WindowsMediaPlayer1 '加入MediaPlayer播放音樂
.URL = "D:\數羊歌.MP3" '請修改音樂檔案
.Visible = False
.Controls.Play '播放音樂
''''''''''''''''''''''''''''''''''''
MsgBox S2
.Controls.stop '關閉音樂
'''''''''''''''''''''''''''''''''
End With
End If
'If S2 <> "" Then MsgBox S2 Else
End Sub

複製代碼

作者: vpower 時間: 2011-5-16 12:23

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-16 13:56

回復 17# vpower
是這樣嗎!

Private Sub CommandButton1_Click()
Dim TheDay#, Msg$, J1%, S$, Hh$, Mm$, Ss$
For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
TheDay = Now - Range("C" & J1).Value: Msg = " 時間已過"
If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間還有"
If Abs(Int(TheDay)) > 0 Then
Mm = Format(Minute(TheDay), "00分鐘")
Ss = Format(Second(TheDay), "00秒")
Hh = Abs(Int(TheDay)) * 24 + Hour(TheDay) & "小時" + Mm + Ss
Else
Hh = Format(TheDay, "hh小時mm分鐘ss秒")
Hh = Replace(Hh, "00小時", "")
End If
Hh = Replace(Replace(Hh, "00分鐘", ""), "00秒", "")
S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & Hh
End If
Next
If S <> "" Then
With Sheet1.WindowsMediaPlayer1 '加入MediaPlayer播放音樂
.URL = "D:\數羊歌.MP3" '請修改音樂檔案
.Visible = False
.Controls.Play '播放音樂
MsgBox S
.Controls.Stop '關閉音樂
End With
End If
End Sub

複製代碼

作者: vpower 時間: 2011-5-16 23:36

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-17 12:51

回復 19# vpower
試試看對?

[attach]6221[/attach]

作者: vpower 時間: 2011-5-17 21:27

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-18 07:51

回復 21# vpower
1.為什麼我把時間欄全部刪除,他還是會播放音樂?點選市件查看的時候也會直接播放音樂
不會的 S <> "" 才會播放音樂的你有修改程式嗎?

If S <> "" Then
With Sheet1.WindowsMediaPlayer1 '加入MediaPlayer播放音樂
.URL = "D:\數羊歌.MP3" '請修改音樂檔案
.Visible = False
.Controls.Play '播放音樂
MsgBox S
.Controls.Stop '關閉音樂
End With
End If

複製代碼

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

作者: vpower 時間: 2011-5-18 20:23

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-19 17:49

回復 23# vpower
試試看

[attach]6272[/attach]

作者: vpower 時間: 2011-5-19 22:52

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-20 06:41

本帖最後由 GBKEE 於 2011-5-20 06:52 編輯

回復 25# vpower
Private Sub XXXXCommandButton1_Click() 還原成  Private Sub CommandButton1_Click()
這段程式碼中  保留紅色部分刪掉其餘
If S <> "" Then
With Sheet1.WindowsMediaPlayer1    '加入MediaPlayer播放音樂
      .URL = "D:\數羊歌.MP3"  '請修改音樂檔案
      .Visible = False
      .Controls.Play       '播放音樂
       MsgBox S, , Format(Now, "dddddd  ttttt")
      .Controls.Stop       '關閉音樂
End With
End If
vbNewLine  或  Chr(10) '加入空一行
Sub 事件() 已修改請複製套入檔案中

Private Sub 事件()
Dim TheDay#, Msg$, J1%, S$, Hh$, Mm$, Ss$, Form_Hight%
Dim H%
Me.Caption = Format(Now, "dddddd ttttt")
For J1 = 2 To Sheets("Sheet1").[C65536].End(xlUp).Row
If Range("C" & J1) <> "" And IsDate(Range("C" & J1)) Then
TheDay = Now - Range("C" & J1).Value: Msg = " 時間已過"
If Range("C" & J1) >= Now Then TheDay = Range("C" & J1) - Now: Msg = " 時間還有"
If Abs(Int(TheDay)) > 0 Then
Mm = Format(Minute(TheDay), "00分鐘")
Ss = Format(Second(TheDay), "00秒")
Hh = Abs(Int(TheDay)) * 24 + Hour(TheDay) & "小時" + Mm + Ss
Else
Hh = Format(TheDay, "hh小時mm分鐘ss秒")
Hh = Replace(Hh, "00小時", "")
End If
Hh = Replace(Replace(Hh, "00分鐘", ""), "00秒", "")
S = IIf(S = "", "", S & vbNewLine) & "距離 " & Sheets("Sheet1").Range("A" & J1) & Msg & Hh & vbNewLine '加入空一行
Form_Hight = Form_Hight + 2
End If
Next
H = 12
With Me
.Label1.Caption = S
.Label1.Height = H * Form_Hight + 5
.Height = .Label1.Height + (H * 2 + 15)
End With
If S = "" Then Unload Me: Exit Sub
End Sub

複製代碼

[attach]6279[/attach]

作者: vpower 時間: 2011-5-20 08:31

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-20 09:00

本帖最後由 GBKEE 於 2011-5-20 09:05 編輯

回復 27# vpower
同一模組中不可有相同的程序名稱
測試2中保留原來的 Private Sub CommandButton1_Click() 我改為 Private Sub XXXXCommandButton1_Click()
所以
原來的Private Sub XXXXCommandButton1_Click() 還原成 Private Sub CommandButton1_Click()
之後要將原來的 Private Sub CommandButton1_Click() 改成 Private Sub XXXXCommandButton1_Click() 或可以刪掉

作者: vpower 時間: 2011-5-20 15:46

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-22 08:14

回復 29# vpower
可以詳看 VBA DateDiff 說明
傳回一 Variant (Long) 的值，表示兩個日期間相差的時間間隔單位數目

作者: vpower 時間: 2011-5-22 14:00

提示: 作者帳號被禁止或禁止訪問

作者: GBKEE 時間: 2011-5-22 14:19

回復 31# vpower
**** 29樓,31樓是兩碼事*****
29樓

請幫我看一下,下面這個的"D",功能是什麼?如果我沒用到,改如何刪除改寫
I1 = DateDiff("D", Date, Range("C" & J1))的"D"

31樓

可是我的"D"欄沒有放日期讓他比較,所以想節省他,不用讓他每次判斷"D"欄.

請問是工作表"D"欄嗎? 你的程式碼沒有比對到"D"欄

你有看 VBA 中的DateDiff 說明嗎?
I1 = DateDiff("D", Date, Range("C" & J1))的"D" 此函數DateDiff 表示兩個日期間相差的時間間隔單位數目
D是天的單位, 所以I1為傳回天數的變數

作者: vpower 時間: 2011-5-23 00:32

提示: 作者帳號被禁止或禁止訪問

作者: vpower 時間: 2011-6-9 09:37

提示: 作者帳號被禁止或禁止訪問

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