一個查詢的表單,

hong912

各版主及各大大, 安好, 小弟初次到這論壇, 亦初次發問, 希望能得到大大回應, 更希望從回應中學習, 現把檔案上傳, 先行謝過各位, 謝謝!!
a.rar (710.24 KB)

下載次數: 36

2012-9-15 11:23

hong912

回復 34# GBKEE

謝謝大大回應, 會於放工後研究及學習, 謝謝!!, 祝節日健康快樂..

GBKEE

回復 33# hong912
修改 查詢檔案 表單程式碼如下

1. Dim PicAr() As Picture '圖片陣列
   
2. Dim fs As String, Sh As Worksheet    ' 表單查詢表 = "E:\temp.jpg" '暫存圖片目錄位置
   
3. Private Const r = 4 '資料起始列號
   
4. Private Sub UserForm_Initialize() '表單初始化
   
5.     Dim Pic As Picture
   
6.     查看資料庫
   
7.     fs = CurDir & "\temp.jpg"  '表單查詢表 這裡修改為當下的目錄 ( CurDir )為暫存圖片目錄位置 表單查詢表
   
8.     With Sh
   
9.         ReDim PicAr(.Pictures.Count)
   
10.         For Each Pic In .Pictures '將每個圖片置入陣列
    
11.             Set PicAr(Pic.TopLeftCell.Row - r) = Pic
    
12.         Next
    
13.         ComboBox1.List = .Range("A4", .[A4].End(xlDown).Offset(, 12)).Value '下拉清單內容
    
14.     End With
    
15.     Image1.PictureSizeMode = fmPictureSizeModeStretch '圖片載入的型態
    
16. End Sub
    
17. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '關閉表單
    
18.     If Dir(fs) <> "" Then Kill fs '刪除暫存圖片檔案
    
19.     Sh.Parent.Close 0             '關閉資料庫檔案
    
20. End Sub
    
21. Private Sub 查看資料庫()
    
22.     Dim 資料庫 As String, Wo As Workbook, Msg As Boolean        'Boolean型態的預設值為 False
    
23.     資料庫 = "D:\資料庫.XLS"                                    '資料庫檔案的路徑目錄
    
24.     For Each Wo In Workbooks                                    '活頁簿物件集合
    
25.         If Wo.FullName = 資料庫 Then                            '資料庫檔案開啟中
    
26.             Msg = True
    
27.             Set Sh = Wo.Sheets(1)                                   '將變數指定為第一個工作表
    
28.             Exit For
    
29.         End If
    
30.     Next
    
31.     Application.ScreenUpdating = False
    
32.     'ScreenUpdating 屬性 如果螢幕更新功能是開啟的則為 True。讀/寫 Boolean。
    
33.      If Msg = False Then Set Sh = CreateObject(資料庫).Sheets(1)
    
34.     '資料庫檔案如未開啟, 開啟它:將變數指定為第一個工作表
    
35.     Application.ScreenUpdating = True
    
36. End Sub

複製代碼

hong912

小弟也在此衷心感謝這篇文章得到2位版主回應及各樓主的注意, 先行說聲謝謝謝!!
基於工作上的需求, 小弟在想, 不知可否把程式改造為两個檔案, 1資料庫檔案, 這檔案是存放資料,
2查詢檔案, 用家在這檔案內按下查詢按鈕, 資料便從檔案室1資料庫中傳回, 功能一樣, 但不同的, 在同
一檔檔案室查詣改為在另一檔案查詢, 這樣的效果是否可做到,
今天是中秋節, 小弟於此, 祝大大們及各樓主節日人月两全, 謝謝!!
查詢.rar (514.62 KB)

下載次數: 19

2012-9-30 11:08

資料庫.rar (514.55 KB)

下載次數: 17

2012-9-30 11:08

周大偉

在此謝過hsieh及gbkee两位超版大, 衷心感謝, 希望能從中學習, 最後祝願中秋節快樂, 謝謝!!

GBKEE

回復 29# 周大偉
CurDir: 傳回前目錄位置
當使用開啟舊檔指令: 所看到的目錄位置

Hsieh

回復 29# 周大偉

1. Dim PicAr() As Picture '圖片陣列
   
2. Dim fs$
   
3. Private Const r = 4 '資料起始列號
   
4. 
   
5. Private Sub ComboBox1_Change() '選擇編號事件
   
6. 
   
7. Dim k%, i%
   
8. 
   
9. With ComboBox1
   
10. 
    
11. k = .ListIndex '下拉選單選取位置
    
12. 
    
13. For i = 1 To 11
    
14. 
    
15.    Controls("TextBox" & i).Text = IIf(i = 11, .List(k, i) & .List(k, i + 1), .List(k, i)) '文字方塊寫入
    
16. 
    
17. Next
    
18. 
    
19. End With
    
20. 
    
21. PicAr(k).CopyPicture '複製圖片
    
22. 
    
23. With Sheet1.ChartObjects.Add(1, 1, PicAr(k).Width, PicAr(k).Height) '新增圖表
    
24. 
    
25. .Chart.Paste '貼上圖片
    
26. 
    
27. .Chart.Export fs '以圖表匯成圖片
    
28. 
    
29. Image1.Picture = LoadPicture(fs) '載入圖片
    
30. 
    
31. .Delete '刪除圖表
    
32. 
    
33. End With
    
34. 
    
35. End Sub
    
36. 
    
37. Private Sub UserForm_Initialize() '表單初始化
    
38.     Dim Pic As Picture
    
39.     fs = CurDir & "\temp.jpg"  '*** 這裡修改為當下的目錄 ( CurDir )為暫存圖片目錄位置 ***
    
40.     With Sheet1
    
41.         ReDim PicAr(.Pictures.Count)
    
42.         For Each Pic In .Pictures '將每個圖片置入陣列
    
43.             Set PicAr(Pic.TopLeftCell.Row - r) = Pic
    
44.         Next
    
45.         ComboBox1.List = .Range("A4", .[A4].End(xlDown).Offset(, 12)).Value '下拉清單內容
    
46.     End With
    
47.     Image1.PictureSizeMode = fmPictureSizeModeStretch '圖片載入的型態
    
48. End Sub
    
49. 
    
50. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '關閉表單
    
51. 
    
52. If Dir(fs) <> "" Then Kill fs '刪除暫存圖片檔案
    
53. 
    
54. End Sub

複製代碼

周大偉

回復 28# GBKEE
先謝謝大大,
     fs = CurDir & "\temp.jpg"  '*** 這裡修改為當下的目錄 ( CurDir )為暫存圖片目錄位置 ***
這句的意思是指目錄位置, 是指, 如c盤d盤, 或檔案路徑, 大大可否指導, 謝謝!!

GBKEE

回復 25# 周大偉

1. Dim PicAr() As Picture '圖片陣列
   
2. Dim fs As String  ' *** = "E:\temp.jpg" '暫存圖片目錄位置
   
3. Private Const r = 4 '資料起始列號
   
4. Private Sub UserForm_Initialize() '表單初始化
   
5.     Dim Pic As Picture
   
6.     fs = CurDir & "\temp.jpg"  '*** 這裡修改為當下的目錄 ( CurDir )為暫存圖片目錄位置 ***
   
7.     With Sheet1
   
8.         ReDim PicAr(.Pictures.Count)
   
9.         For Each Pic In .Pictures '將每個圖片置入陣列
   
10.             Set PicAr(Pic.TopLeftCell.Row - r) = Pic
    
11.         Next
    
12.         ComboBox1.List = .Range("A4", .[A4].End(xlDown).Offset(, 12)).Value '下拉清單內容
    
13.     End With
    
14.     Image1.PictureSizeMode = fmPictureSizeModeStretch '圖片載入的型態
    
15. End Sub

複製代碼

Hsieh

回復 26# 317


    可能是電腦中沒有E槽分割吧