一個查詢的表單,

帖子: 97
主題: 31
精華: 0
積分: 133
點名: 0
作業系統: xp2007
軟體版本: xp2007
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2012-8-12
最後登錄: 2020-12-25

35^#

發表於 2012-9-30 16:14 | 只看該作者

回復 34# GBKEE

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

hong912

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

34^#

發表於 2012-9-30 15:50 | 只看該作者

本帖最後由 GBKEE 於 2012-9-30 15:51 編輯

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

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

複製代碼

hong912

帖子: 97
主題: 31
精華: 0
積分: 133
點名: 0
作業系統: xp2007
軟體版本: xp2007
閱讀權限: 20
性別: 男
來自: 香港
註冊時間: 2012-8-12
最後登錄: 2020-12-25

33^#

發表於 2012-9-30 11:09 | 只看該作者

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

查詢.rar (514.62 KB)

資料庫.rar (514.55 KB)

hong912

周大偉

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

32^#

發表於 2012-9-29 20:24 | 只看該作者

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

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

31^#

發表於 2012-9-29 16:34 | 只看該作者

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

Hsieh

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

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

30^#

發表於 2012-9-29 09:30 | 只看該作者

回復 29# 周大偉

Dim PicAr() As Picture '圖片陣列
Dim fs$
Private Const r = 4 '資料起始列號
Private Sub ComboBox1_Change() '選擇編號事件
Dim k%, i%
With ComboBox1
k = .ListIndex '下拉選單選取位置
For i = 1 To 11
Controls("TextBox" & i).Text = IIf(i = 11, .List(k, i) & .List(k, i + 1), .List(k, i)) '文字方塊寫入
Next
End With
PicAr(k).CopyPicture '複製圖片
With Sheet1.ChartObjects.Add(1, 1, PicAr(k).Width, PicAr(k).Height) '新增圖表
.Chart.Paste '貼上圖片
.Chart.Export fs '以圖表匯成圖片
Image1.Picture = LoadPicture(fs) '載入圖片
.Delete '刪除圖表
End With
End Sub
Private Sub UserForm_Initialize() '表單初始化
Dim Pic As Picture
fs = CurDir & "\temp.jpg" '*** 這裡修改為當下的目錄 ( CurDir )為暫存圖片目錄位置 ***
With Sheet1
ReDim PicAr(.Pictures.Count)
For Each Pic In .Pictures '將每個圖片置入陣列
Set PicAr(Pic.TopLeftCell.Row - r) = Pic
Next
ComboBox1.List = .Range("A4", .[A4].End(xlDown).Offset(, 12)).Value '下拉清單內容
End With
Image1.PictureSizeMode = fmPictureSizeModeStretch '圖片載入的型態
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '關閉表單
If Dir(fs) <> "" Then Kill fs '刪除暫存圖片檔案
End Sub

複製代碼

學海無涯_不恥下問

周大偉

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

29^#

發表於 2012-9-28 19:10 | 只看該作者

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

GBKEE

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

28^#

發表於 2012-9-28 16:40 | 只看該作者

回復 25# 周大偉

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

複製代碼

Hsieh

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

2025年全勤獎章 2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

27^#

發表於 2012-9-28 07:16 | 只看該作者

回復 26# 317

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

學海無涯_不恥下問