請問高手要將以下DDE 每分鐘記錄改為30秒自動記錄一次要怎改
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
回復 57# devidlin
類似用時鐘方式或是一個方塊在右邊方式提醒注意
如圖嗎?
程式碼複製後存檔,再開檔試看看
ThisWorkbook模組的程式碼
- Private Sub Workbook_Open()
- UserForm1.Show
- End Sub
複製代碼
附檔上 插入一UserForm(表單) 系統自動命名 (UserForm1)
UserForm(表單)的程式碼
- Option Explicit
- Dim Msg As Boolean
- Private Sub UserForm_Initialize() 'UserForm(表單) 初始化時的事件程序
- '請先在UserForm(表單) 加入4個 Label控制項
- '系統自動命名(Label1, Label2 , Label3 , Label4)
- '請自行調整 4個 Label控制項 的位置,長,寬,高
- Dim i As Integer
- For i = 1 To 4
- With Me.Controls("Label" & i)
- .TextAlign = 1 ' fmTextAlignCenter
- .Font.Bold = True
- .Font.Size = 15
- .SpecialEffect = fmSpecialEffectEtched
- End With
- Next
- End Sub
- Private Sub UserForm_Activate() 'UserForm(表單) 顯示時的事件程序
- Dim xlTile As String, S As String
- S = Space(5)
- Application.Visible = False
- Do Until Msg = True
- DoEvents
- If Time < #8:00:00 AM# Then
- xlTile = "尚未開盤"
- ElseIf Time > #1:30:00 PM# Then
- xlTile = "已收盤"
- Else
- xlTile = "營業中"
- End If
- If Not Msg Then Caption = Format(Now, "Dddddd ttttt ") & xlTile
- If xlTile <> "尚未開盤" Then
- Label1.Caption = S & [sheet1!K1] & S & [ROUND(sheet1!K2,3)]
- Label2.Caption = S & [sheet1!L1] & S & [ROUND(sheet1!L2,3)]
- Label3.Caption = S & [sheet1!M1] & S & [ROUND(sheet1!M2,3)]
- Label4.Caption = S & [sheet1!N1] & S & [ROUND(sheet1!N2,3)]
- End If
- Loop
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'UserForm(表單) 關閉時的事件程序
- Msg = True
- Application.Visible = True
- End Sub
複製代碼 |
|
|
|
|
|
|
|
- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2012-10-16 16:03 編輯
回復 78# devidlin
依55# 的附檔 很簡單的自己練習看看,
表單要先弄好的,將程式碼更新為如下,存檔後再開啟看看.
ThisWorkbook程式碼- Dim AA As New Application '新的Excel 物件
- Sub Workbook_Open()
- Application.Visible = False
- With AA
- .Visible = True
- .WindowState = xlNormal
- .Left = 242
- .Top = 59
- .Width = 648
- .Height = 401
- End With
- UserForm1.Show
- End Sub
複製代碼 UserForm(表單)程式碼- Dim Msg As Boolean
- Private Sub UserForm_Initialize() 'UserForm(表單) 初始化時的事件程序
- '請先在UserForm(表單) 加入4個 Label控制項
- '系統自動命名(Label1, Label2 , Label3 , Label4)
- '請自行調整 4個 Label控制項 的位置,長,寬,高
- Dim i As Integer
- StartUpPosition = 0
- Top = 1
- For i = 1 To 4
- With Me.Controls("Label" & i)
- .TextAlign = 1 ' fmTextAlignCenter
- .Font.Bold = True
- .Font.Size = 15
- .SpecialEffect = fmSpecialEffectEtched
- End With
- Next
- End Sub
- Private Sub UserForm_Activate() 'UserForm(表單) 顯示時的事件程序
- Dim xlTile As String, S As String
- S = Space(5)
- Do Until Msg = True
- DoEvents
- If Time < #8:00:00 AM# Then
- xlTile = "尚未開盤"
- ElseIf Time > #1:30:00 PM# Then
- xlTile = "已收盤"
- Else
- xlTile = "營業中"
- End If
- If Not Msg Then Caption = Format(Now, "Dddddd ttttt ") & xlTile
- If xlTile <> "尚未開盤" Then
- Label1.Caption = S & [sheet1!K1] & S & [ROUND(sheet1!K2,3)]
- Label2.Caption = S & [sheet1!L1] & S & [ROUND(sheet1!L2,3)]
- Label3.Caption = S & [sheet1!M1] & S & [ROUND(sheet1!M2,3)]
- Label4.Caption = S & [sheet1!N1] & S & [ROUND(sheet1!N2,3)]
- End If
- Loop
- End Sub
- Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'UserForm(表單) 關閉時的事件程序
- Msg = True
- Application.Visible = True
- ThisWorkbook.Save
- Application.Quit
- End Sub
複製代碼 |
|
|
|
|
|
|
|