- 帖子
- 115
- 主題
- 24
- 精華
- 0
- 積分
- 178
- 點名
- 0
- 作業系統
- WIN10
- 軟體版本
- Office2016
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2011-1-12
- 最後登錄
- 2024-11-15
|
回復 10# 准提部林
謝謝准提大
這兩個檔案實際使用情形是:
1. 資料檔(生產紀錄) 和 要抓資料的檔(生產日報)是存放在同一個資料夾裡並開放共用。
2. 資料檔是產線一直開著， 一但有產出就由產線即時輸入產出資料，其他電腦只能用唯讀模式開啟 這個檔案。
3. 抓資料的檔是主管在另外一台電腦開啟使用的。
我將准提大的碼 置入阿龍大程式碼的這個位置，
如果資料檔和抓資料的檔在同一台電腦同時開著，可以抓取資料且資料檔不會關閉。
但若是 資料檔是關閉時， 執行抓資料程式就會出現錯誤訊息。
可否:
1.當資料檔無任何人開啟時， 讓主管只開啟抓資料的檔 執行抓資料程式時，資料檔會自行開啟並執行抓取資料，完成後資料檔不會自行關閉 (由主管自行手動關閉)
2.當有其他台電腦在使用資料檔時, 主管只開啟抓資料的檔 執行抓資料程式時，資料檔是以唯讀模式開啟後抓取資料，資料抓取完成後資料檔(唯讀模式)不會自行關閉 (由主管自行手動關閉)
以下是准提大的程式碼置入阿龍大的程式碼:- Sub 查詢投產數量()
- '宣告變數
- Dim 檔名$, 路徑檔名$, tt$, R&
- Application.ScreenUpdating = False '螢幕即時更新關閉
- Set Dy = CreateObject("scripting.dictionary") '設Dy為字典物件
- Path = ThisWorkbook.Path '抓取本檔案路徑
- '命名此工作表為 "要填的表"
- Set 要填的表 = ThisWorkbook.Sheets("2018三廠機台生產追蹤")
- '如果[G5]有資料就依[G5]路徑的檔案，如果沒到就找同路徑下的另一個excel檔
- If [G5] <> "" Then
- 路徑檔名 = [G5]
- 檔名 = Right(路徑檔名, Len(路徑檔名) - InStrRev(路徑檔名, "\"))
- If Dir(路徑檔名) = "" Then MsgBox "依[G5]輸入的路徑與檔名找不到檔案，請檢查有無錯誤": Exit Sub
- Else
- 檔名 = Dir(Path & "\*.xls*")
- If 檔名 = ThisWorkbook.Name Then 檔名 = Dir
- 路徑檔名 = Path & "\" & 檔名
- End If
-
- '檢查資料檔案是否已開啟
- For Each wb In Workbooks
- 'If wb.Name = 檔名 Then MsgBox "資料檔案開啟中，請關閉": Exit Sub
-
-
- '檢查資料檔案是否已開啟, 若未開啟則以[唯讀]開啟, 並以uChk標示為1
- On Error Resume Next
- uChk = 0: Set 資料檔 = Workbooks(檔名)
- On Error GoTo 0
- If 資料檔 Is Nothing Then uChk = 1: Set 資料檔 = Workbooks.Open(路徑檔名, ReadOnly:=True)
- '關閉檔案_不存檔 (若資料檔不是程式所開啟, 則不關閉)
- If uChk = 1 Then 資料檔.Close 0
- Next
- '打開資料檔案，並且命名為"資料檔"
- Set 資料檔 = Workbooks.Open(路徑檔名)
- '逐一把工作表的生產代碼與頭產數量輸入到字典物件Dy裡面
- For Each ws In 資料檔.Sheets
- ws.Activate
- If ws.[D1] <> "投產數量" Then GoTo 跳過 '檢查是否為要的工作表
- For R = 2 To ws.[A1].End(xlDown).Row
- tt = Cells(R, 3): Dy(tt) = Cells(R, 4)
- Next R
- 跳過:
- Next
- '啟用要填的表
- 要填的表.Activate
- '逐一把字典物件Dy裡面的值輸入到此工作表(要填的表)
- For R = 2 To [A1].End(xlDown).Row
- tt = Cells(R, 4)
- Cells(R, 5) = Dy(tt)
- Next R
- '不跳出確認訊息
- Application.DisplayAlerts = False
- '存檔關閉+釋放記憶體
- '資料檔.Close True: Set 資料檔 = Nothing
- 'Set Dy = Nothing
- '螢幕即時更新打開
- Application.ScreenUpdating = True
- End Sub
|
|
發表於 2018-9-2 18:13
| 
