c_c_lai

回復 61# devidlin

下載 (40.09 KB)

2012-10-15 19:21

元大-盤中DDE紀錄1015一經啟動，便同時會開啟UserForm(表單)，
一旦開啟UserForm(表單)後，所有畫面控制權便由表單掌控，此時是
無法切換工作表單的 (如想要閱覽非目前工作表單之內容)。
為解決此困惱，我增加了一個按鈕 "摩台價差"，當你關閉(X)UserForm(表單)後，
你可以透過 "摩台價差"按鈕再次開啟它，此動作是不會引響 DDE 之正常匯入。
雖然會感覺有些不方便，但習慣就好了。
同時在此也要謝謝 GBKEE 版大的協助與指導！
元大-盤中DDE紀錄1015.rar (30.17 KB)

下載次數: 53

2012-10-15 19:39

GBKEE

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

c_c_lai

回復 64# GBKEE
我將
1.   Private Sub showUsrForm() 改成 Sub showUsrForm()
2.   下面兩個涵式各加入showUsrForm。

1. Sub 摩台價差()
   
2.     If UserForm1.Visible = False Then
   
3.         UserForm1.Show
   
4.         showUsrForm
   
5.     Else
   
6.         UserForm1.Hide
   
7.     End If
   
8. End Sub

複製代碼

和

1. Private Sub UserForm_Initialize()         '  UserForm(表單) 初始化時的事件程序
   
2.     Dim i As Integer
   
3. 
   
4.     '  請先在UserForm(表單) 加入4個 Label控制項
   
5.     '  系統自動命名(Label1, Label2 , Label3 , Label4)
   
6.     '  請自行調整 4個 Label控制項 的位置,長,寬,高
   
7.    
   
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. 
    
17.     If Caption = "UserForm1" Then Caption = Format(Now, "Dddddd ttttt ")
    
18.     ThisWorkbook.showUsrForm
    
19. End Sub

複製代碼

視覺感就OK了。

GBKEE

回復 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

複製代碼

c_c_lai

回復 66# GBKEE
我知道，這是故意放上的，因一開始會顯示 UserForm1 不好看才放上的，
謝謝您！
順便請教，在如何自動篩選+存到新工作表裡，最後為什麼要 .Rows(xlRow).Delete
刪除 xlRow 那筆紀錄呢？ 因為它有 2 筆呢。

minyow

是否应將MINUTE改為SECOND

GBKEE

回復 67# c_c_lai
對樓主的發問不太明瞭    回覆有說 是這樣嗎?  
如有2筆資料 須修改為

1.     .Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Offset(2).Delete xlUp

複製代碼

c_c_lai

回復 68# minyow
間格時段可依你個人需求予以更動的，
譬如： 一秒、五秒、十秒、二十秒、三十秒等，
亦或是一分、五分、十分、二十分、三十分。
你只要異動間格時段該欄位值即可，非常方便。
盤中修正它會在異動後之下一輪迴自動修正的。

c_c_lai

回復 69# GBKEE
我指的是：

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Car_No As String, xlRow As Integer
   
4.    
   
5.     With Sheet1
   
6.         .Activate
   
7.         .AutoFilterMode = False
   
8.         
   
9.         Car_No = InputBox("請輸入車號")
   
10.         If Car_No = "" Then MsgBox "沒輸入 車號 ??" & Car_No: Exit Sub
    
11.         
    
12.         .Rows(2).Cells(1).AutoFilter Field:=9, Criteria1:=UCase(Car_No)   ' 9 - 車號
    
13.         '  AutoFilter 執行完畢後，此時工作表單內容僅會顯示與Car_No條件吻合之資料項。
    
14.         '  假設原有5筆紀錄，而吻合條件的只有2筆，那此時表單內容只顯示出那2筆資料錄。
    
15.         xlRow = .Rows(2).Cells(9).End(xlDown).Row
    
16.         
    
17.         If xlRow <> Rows.Count Then                      '  Rows.Count = 65536
    
18.             .Cells.SpecialCells(xlCellTypeVisible).Copy  '  將表單內所有內容複製。
    
19.         Else
    
20.             MsgBox "找不到 車號 !! " & Car_No:      Exit Sub
    
21.         End If
    
22.         
    
23.         With Sheets.Add(, Sheets("sheet1"))   ' 在原sheet1後新增一個工作表單(工作表1)
    
24.             .Paste                            ' 將複製之所有內容貼入至新表單內。
    
25.             Application.CutCopyMode = False
    
26.             .Name = .[i3]                     ' 將新增之工作表單，命名為Car_No的內容。
    
27.             .[a1].Select                      ' 將游標移至 A1 欄位上。
    
28.         End With
    
29.         
    
30.         .Rows(xlRow).Delete                   ' 將原sheet1內第xlRow列資料項刪除掉。([color=Red]Why?[/color])
    
31.         .AutoFilterMode = False
    
32.         .Activate
    
33.     End With
    
34. End Sub

複製代碼

c_c_lai

回復 70# c_c_lai
附上執行後之圖示畫面：

下載 (17.84 KB)

2012-10-16 09:54