返回列表 上一主題 發帖

一個查詢的表單,

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兔年全勤獎章
1# 跳轉到 »
發表於 2012-9-22 00:12 | 顯示全部帖子
回復 11# hong912

試試看下列程式碼
  1. Dim PicAr() As Picture '圖片陣列
  2. Private Const fs = "E:\temp.jpg" '暫存圖片目錄位置
  3. Private Const r = 4 '資料起始列號
  4. Private Sub ComboBox1_Change() '選擇編號事件
  5. Dim k%, i%
  6. With ComboBox1
  7. k = .ListIndex '下拉選單選取位置
  8. For i = 1 To 11
  9.    Controls("TextBox" & i).Text = IIf(i = 11, .List(k, i) & .List(k, i + 1), .List(k, i)) '文字方塊寫入
  10. Next
  11. End With
  12. PicAr(k).CopyPicture '複製圖片
  13. With Sheet1.ChartObjects.Add(, , PicAr(k).Width, PicAr(k).Height) '新增圖表
  14. .Chart.Paste '貼上圖片
  15. .Chart.Export fs '以圖表匯成圖片
  16. Image1.Picture = LoadPicture(fs) '載入圖片
  17. .Delete '刪除圖表
  18. End With
  19. End Sub


  22. Private Sub UserForm_Initialize() '表單初始化
  23. Dim Pic As Picture
  24. With Sheet1
  25. ReDim PicAr(.Pictures.Count)
  26. For Each Pic In .Pictures '將每個圖片置入陣列
  27.   Set PicAr(Pic.TopLeftCell.Row - r) = Pic
  28. Next
  29. ComboBox1.List = .Range("A4", .[A4].End(xlDown).Offset(, 12)).Value '下拉清單內容
  30. End With
  31. Image1.PictureSizeMode = fmPictureSizeModeStretch '圖片載入的型態
  32. End Sub

  34. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '關閉表單
  35. If Dir(fs) <> "" Then Kill fs '刪除暫存圖片檔案
  36. End Sub
複製代碼
表單圖片查詢.rar (1.28 MB)
學海無涯_不恥下問

TOP

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兔年全勤獎章
2#
發表於 2012-9-23 23:41 | 顯示全部帖子
回復 18# hong912

請上傳無法讀取的問題檔案
應該只要是能插入到工作表中的圖片均可讀取才對
學海無涯_不恥下問

TOP

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兔年全勤獎章
3#
發表於 2012-9-25 22:31 | 顯示全部帖子
回復 21# 周大偉
沒注意到2003以外版本，圖表新增時，不可忽略left與top引數
With Sheet1.ChartObjects.Add(1, 1, PicAr(k).Width, PicAr(k).Height)
學海無涯_不恥下問

TOP

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兔年全勤獎章
4#
發表於 2012-9-25 23:04 | 顯示全部帖子
回復 23# 周大偉


    可能是
Private Const fs = "E:\temp.jpg" '暫存圖片目錄位置
這個目錄位置不存在
學海無涯_不恥下問

TOP

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兔年全勤獎章
5#
發表於 2012-9-28 07:16 | 顯示全部帖子
回復 26# 317


    可能是電腦中沒有E槽分割吧
學海無涯_不恥下問

TOP

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兔年全勤獎章
6#
發表於 2012-9-29 09:30 | 顯示全部帖子
回復 29# 周大偉
  1. Dim PicAr() As Picture '圖片陣列
  2. Dim fs$
  3. Private Const r = 4 '資料起始列號

  5. Private Sub ComboBox1_Change() '選擇編號事件

  7. Dim k%, i%

  9. With ComboBox1

  11. k = .ListIndex '下拉選單選取位置

  13. For i = 1 To 11

  15.    Controls("TextBox" & i).Text = IIf(i = 11, .List(k, i) & .List(k, i + 1), .List(k, i)) '文字方塊寫入

  17. Next

  19. End With

  21. PicAr(k).CopyPicture '複製圖片

  23. With Sheet1.ChartObjects.Add(1, 1, PicAr(k).Width, PicAr(k).Height) '新增圖表

  25. .Chart.Paste '貼上圖片

  27. .Chart.Export fs '以圖表匯成圖片

  29. Image1.Picture = LoadPicture(fs) '載入圖片

  31. .Delete '刪除圖表

  33. End With

  35. End Sub

  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

  50. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) '關閉表單

  52. If Dir(fs) <> "" Then Kill fs '刪除暫存圖片檔案

  54. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 做好事不能少我一人，做壞事不能多我一人。
返回列表 上一主題