麻辣家族討論版版 » Excel程式區 » 請教如何修改程式

返回列表下一主題上一主題發帖

請教如何修改程式

中學生 Rank: 2

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2016-12-2 18:51 | 只看該作者

請教如何修改程式

請教大大們,
下次程式是個下拉傳回資料程式, 程式把另一檔案資料傳回, 當程式運行中, 會自行開啟另一檔案, 傳回資料後, 該被開啟檔案會自行關聞, 現時我希望能做到程式必須於兩個檔案同時開啟下才能運行. 請大大們指導, 謝!!
Private Sub ComboBox1_Change()
With ComboBox1
i = .ListIndex
If i = -1 Then Exit Sub
ar = Array(Month(Date), Date, .List(i, 1), .List(i, 2), .List(i, 3), .List(i, 4), "", .List(i, 5))
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 8) = ar
End With
End Sub

Private Sub ComboBox1_DropButtonClick()
Application.ScreenUpdating = False
fs = ThisWorkbook.Path & "\sal名冊.xlsm"
With Workbooks.Open(fs)
With .Sheets("人員名稱")
   ar = .Range(.[A4], .[A3].End(xlDown).Offset(, 5))
   With ComboBox1
   .ColumnCount = 3
   .List = ar
   .ColumnWidths = "0,30,40"
   End With
End With
.Close 0
End With
Application.ScreenUpdating = True
End Sub

樓主熱帖

收藏

中學生 Rank: 2

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

2^#

發表於 2016-12-3 10:27 | 只看該作者

大大們, 早晨
如何修改程式, 沒有回應
現把檔案上傳, 檔案在申請表下拉中選擇後傳回資料, 無須開啟資料庫檔案, 小弟現希望能在兩個檔案同時開啟下運行, 傳回資料後, 兩個檔案依然開著..謝謝!!

申請表.rar (22.29 KB)

資料庫.rar (17.36 KB)

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2819
主題: 10
精華: 0
積分: 2875
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-6-29

3^#

發表於 2016-12-3 10:40 | 只看該作者

Private Sub ComboBox1_DropButtonClick()
Dim DataBook As Workbook
On Error Resume Next
Set DataBook = Workbooks("資料庫.xlsm")
On Error GoTo 0
If DataBook Is Nothing Then MsgBox "資料庫檔案未開啟! ": Exit Sub

With DataBook.Sheets("工作表1")
　　　ar = .Range(.[A4], .[A3].End(xlDown).Offset(, 5))
　　　With ComboBox1
　　　　　　.ColumnCount = 3
　　　　　　.List = ar
　　　　　　.ColumnWidths = "0,30,40"
　　　End With
End With
End Sub

中學生 Rank: 2

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

4^#

發表於 2016-12-3 13:23 | 只看該作者

回復 3# 准提部林
感謝協助, 祝願身體健, 快樂, 謝謝!!

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

5^#

發表於 2016-12-3 17:17 | 只看該作者

回復 2# 周大偉
試試難！

Private Sub ComboBox1_DropButtonClick()
Dim DataBook As Workbook, fs As String
Application.ScreenUpdating = False
On Error Resume Next
fs = ThisWorkbook.Path & "\資料庫.xlsm"
Set DataBook = Workbooks(fs)
On Error GoTo 0
If DataBook Is Nothing Then
Set DataBook = Workbooks.Open(fs)
End If
With DataBook.Sheets("工作表1")
ar = .Range(.[A4], .[A3].End(xlDown).Offset(, 5))
With ComboBox1
.ColumnCount = 3
.List = ar
.ColumnWidths = "0,30,40"
End With
End With
DataBook.Close 0
Application.ScreenUpdating = True
End Sub

複製代碼

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

6^#

發表於 2016-12-3 17:33 | 只看該作者

回復 2# 周大偉

Private Sub ComboBox1_DropButtonClick()
Dim DataBook As Workbook, fs As String
Application.ScreenUpdating = False
On Error Resume Next
fs = ThisWorkbook.Path & "\資料庫.xlsm"
Set DataBook = Workbooks(fs)
On Error GoTo 0
If DataBook Is Nothing Then
Set DataBook = Workbooks.Open(fs)
End If
With DataBook
With Sheets("工作表1")
ar = .Range(.[A4], .[A3].End(xlDown).Offset(, 5))
With ComboBox1
.ColumnCount = 3
.List = ar
.ColumnWidths = "0,30,40"
End With
End With
.Close 0
End With
Application.ScreenUpdating = True
End Sub

複製代碼

稍加整理版。

中學生 Rank: 2

帖子: 250
主題: 59
精華: 0
積分: 313
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
性別: 男
來自: 澳門
註冊時間: 2010-9-11
最後登錄: 2020-1-6

7^#

發表於 2016-12-3 22:50 | 只看該作者

回復 6# c_c_lai
衷心感謝大大回應，祝願身體健康，快樂，謝謝。

靜思自在 : 話多不如話少，話少不如話好。

返回列表下一主題上一主題