返回列表 上一主題 發帖

下拉可有此奇效功能的

hong912

帖子
97 
主題
31 
精華
0 
積分
133 
點名
0  
作業系統
xp2007 
軟體版本
xp2007 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2012-8-12 
最後登錄
2020-12-25 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-5-4 22:26 | 只看該作者

下拉可有此奇效功能的

請教大大們一個下拉奇想問題, 現把檔案上傳, 申請表檔案內有說明, 先謝過大大們.
資料庫.rar (16.91 KB) 申請表.rar (13.43 KB)
收藏 分享
hong912

hong912

帖子
97 
主題
31 
精華
0 
積分
133 
點名
0  
作業系統
xp2007 
軟體版本
xp2007 
閱讀權限
20 
性別
男 
來自
香港 
註冊時間
2012-8-12 
最後登錄
2020-12-25 
3#
發表於 2013-5-5 17:42 | 只看該作者
回復 2# Hsieh

謝謝版大回應,
VBA真的可以做到, 但都要有版大這等高手才能運動, 謝謝!!
hong912

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
255  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-24 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2013-5-5 15:06 | 只看該作者
回復 1# hong912

兩檔案置於同一資料夾內
下拉選單所在的工作表模組程式碼
  1. Private Sub ComboBox1_Change()
  2. With ComboBox1
  3. i = .ListIndex
  4. If i = -1 Then Exit Sub
  5. ar = Array(Month(Date), Date, .List(i, 1), .List(i, 2), .List(i, 3), .List(i, 4), "", .List(i, 5))
  6. Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(, 8) = ar
  7. End With
  8. End Sub

  10. Private Sub ComboBox1_DropButtonClick()
  11. Application.ScreenUpdating = False
  12. fs = ThisWorkbook.Path & "\資料庫.xlsx"
  13. With Workbooks.Open(fs)
  14.    With .Sheets("工作表1")
  15.       ar = .Range(.[A4], .[A3].End(xlDown).Offset(, 5))
  16.       With ComboBox1
  17.       .ColumnCount = 3
  18.       .List = ar
  19.       .ColumnWidths = "0,30,40"
  20.       End With
  21.     End With
  22. .Close 0
  23. End With
  24. Application.ScreenUpdating = True
  25. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 人要知福、惜福、再造福。
返回列表 上一主題