返回列表 上一主題 發帖

請問高手要將以下DDE 每分鐘記錄改為30秒自動記錄一次要怎改

回復 57# devidlin
類似用時鐘方式或是一個方塊在右邊方式提醒注意
如圖嗎?

EX1.GIF
2012-10-15 17:13


程式碼複製後存檔,再開檔試看看

ThisWorkbook模組的程式碼
  1. Private Sub Workbook_Open()
  2.     UserForm1.Show
  3. End Sub
複製代碼

附檔上 插入一UserForm(表單)  系統自動命名 (UserForm1)
UserForm(表單)的程式碼
  1. Option Explicit
  2. Dim Msg As Boolean
  3. Private Sub UserForm_Initialize()   'UserForm(表單) 初始化時的事件程序
  4.     '請先在UserForm(表單) 加入4個 Label控制項
  5.     '系統自動命名(Label1, Label2 , Label3 , Label4)
  6.     '請自行調整 4個 Label控制項 的位置,長,寬,高
  7.     Dim i As Integer
  8.     For i = 1 To 4
  9.         With Me.Controls("Label" & i)
  10.             .TextAlign = 1 ' fmTextAlignCenter
  11.             .Font.Bold = True
  12.             .Font.Size = 15
  13.             .SpecialEffect = fmSpecialEffectEtched
  14.         End With
  15.     Next
  16. End Sub
  17. Private Sub UserForm_Activate()       'UserForm(表單) 顯示時的事件程序
  18.     Dim xlTile As String, S As String
  19.     S = Space(5)
  20.     Application.Visible = False
  21.     Do Until Msg = True
  22.         DoEvents
  23.         If Time < #8:00:00 AM# Then
  24.             xlTile = "尚未開盤"
  25.         ElseIf Time > #1:30:00 PM# Then
  26.             xlTile = "已收盤"
  27.         Else
  28.             xlTile = "營業中"
  29.         End If
  30.         If Not Msg Then Caption = Format(Now, "Dddddd ttttt ") & xlTile
  31.         If xlTile <> "尚未開盤" Then
  32.             Label1.Caption = S & [sheet1!K1] & S & [ROUND(sheet1!K2,3)]
  33.             Label2.Caption = S & [sheet1!L1] & S & [ROUND(sheet1!L2,3)]
  34.             Label3.Caption = S & [sheet1!M1] & S & [ROUND(sheet1!M2,3)]
  35.             Label4.Caption = S & [sheet1!N1] & S & [ROUND(sheet1!N2,3)]
  36.         End If
  37.     Loop
  38. End Sub
  39. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'UserForm(表單) 關閉時的事件程序
  40.     Msg = True
  41.     Application.Visible = True
  42. End Sub
複製代碼

TOP

回復 60# c_c_lai
否則會出現錯誤訊息 是資料不正確嗎?
請改用55#的檔案試試看, 或是  sheet1 改成 DEE 看看
  回復 63# c_c_lai
當你關閉(X)UserForm(表單)後,你可以透過 "摩台價差"按鈕再次開啟
有修正的必要  
如隨後再按鈕: 開啟的表單, 會停留在.  " 資料載入中 ............"     沒有執行 ThisWorkbook模組中 Sub showUsrForm()

TOP

回復 65# c_c_lai
你已將兩個程序各加入showUsrForm,請按 F8  執行 Sub 摩台價差() 可看看  UserForm1.Show 是如何操作

  1. Private Sub UserForm_Initialize()   'UserForm(表單) 初始化時的事件程序
  2.     '  If Caption = "UserForm1" Then Caption = Format(Now, "Dddddd ttttt ")
  3.      ' 這 If Caption = "UserForm1"  是多餘的  
  4.         Caption = Format(Now, "Dddddd ttttt ")
  5. End Sub
複製代碼

TOP

回復 67# c_c_lai
對樓主的發問不太明瞭    回覆有說 是這樣嗎?  
如有2筆資料 須修改為
  1.     .Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Offset(2).Delete xlUp
複製代碼

TOP

本帖最後由 GBKEE 於 2012-10-16 10:12 編輯

回復 72# c_c_lai
.Rows(xlRow).Delete
是在寫這程式時沒注意到同 一車號會有一筆資料以上所以只刪一行
http://forum.twbts.com/viewthread.php?tid=8048&rpid=45188&ordertype=0&page=1#pid45188
這裡已修改可刪多行
.Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Offset(2).Delete xlUp

TOP

回復 76# devidlin
那要在VB 中製成
取巧方式: 執行此檔案後, 可如  59# 的圖片 另開Excel程式,執行其他Excel活頁簿 .

TOP

本帖最後由 GBKEE 於 2012-10-16 16:03 編輯

回復 78# devidlin
依55# 的附檔 很簡單的自己練習看看,
表單要先弄好的,將程式碼更新為如下,存檔後再開啟看看.
ThisWorkbook程式碼
  1. Dim AA As New Application   '新的Excel 物件
  2. Sub Workbook_Open()
  3.     Application.Visible = False
  4.     With AA
  5.         .Visible = True
  6.         .WindowState = xlNormal
  7.         .Left = 242
  8.         .Top = 59
  9.         .Width = 648
  10.         .Height = 401
  11.     End With
  12.     UserForm1.Show
  13. End Sub
複製代碼
UserForm(表單)程式碼
  1. Dim Msg As Boolean
  2. Private Sub UserForm_Initialize()   'UserForm(表單) 初始化時的事件程序
  3.     '請先在UserForm(表單) 加入4個 Label控制項
  4.     '系統自動命名(Label1, Label2 , Label3 , Label4)
  5.     '請自行調整 4個 Label控制項 的位置,長,寬,高
  6.     Dim i As Integer
  7.     StartUpPosition = 0
  8.     Top = 1
  9.     For i = 1 To 4
  10.         With Me.Controls("Label" & i)
  11.             .TextAlign = 1 ' fmTextAlignCenter
  12.             .Font.Bold = True
  13.             .Font.Size = 15
  14.             .SpecialEffect = fmSpecialEffectEtched
  15.         End With
  16.     Next
  17. End Sub
  18. Private Sub UserForm_Activate()       'UserForm(表單) 顯示時的事件程序
  19.     Dim xlTile As String, S As String
  20.     S = Space(5)
  21.     Do Until Msg = True
  22.         DoEvents
  23.         If Time < #8:00:00 AM# Then
  24.             xlTile = "尚未開盤"
  25.         ElseIf Time > #1:30:00 PM# Then
  26.             xlTile = "已收盤"
  27.         Else
  28.             xlTile = "營業中"
  29.         End If
  30.         If Not Msg Then Caption = Format(Now, "Dddddd ttttt ") & xlTile
  31.         If xlTile <> "尚未開盤" Then
  32.             Label1.Caption = S & [sheet1!K1] & S & [ROUND(sheet1!K2,3)]
  33.             Label2.Caption = S & [sheet1!L1] & S & [ROUND(sheet1!L2,3)]
  34.             Label3.Caption = S & [sheet1!M1] & S & [ROUND(sheet1!M2,3)]
  35.             Label4.Caption = S & [sheet1!N1] & S & [ROUND(sheet1!N2,3)]
  36.         End If
  37.     Loop
  38. End Sub
  39. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 'UserForm(表單) 關閉時的事件程序
  40.     Msg = True
  41.     Application.Visible = True
  42.     ThisWorkbook.Save
  43.     Application.Quit
  44. End Sub
複製代碼

TOP

回復 80# devidlin
它還是Excel 檔案


test.rar (19.99 KB)

TOP

回復 82# c_c_lai
再試試看
如真的不可以 那請在 2003版本下試試看
  1. Dim AA As New Application
  2. Sub Workbook_Open()
  3.     Application.Visible = False
  4.     With AA
  5.         .Visible = True
  6.         .WindowState = xlNormal
  7.         .Left = 242
  8.         .Top = 59
  9.         .Width = 648
  10.         .Height = 401
  11.         With .FileDialog(msoFileDialogFilePicker)
  12.             .Show
  13.             If .SelectedItems.Count > 0 Then
  14.                 .Parent.Workbooks.Open (.SelectedItems(1))
  15.             Else
  16.                 .Parent.Workbooks.Add
  17.             End If
  18.         End With
  19.     End With
  20.     UserForm1.Show
  21. End Sub
複製代碼

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大,小人氣大。
返回列表 上一主題