返回列表 上一主題 發帖

一個查詢的表單,

一個查詢的表單,

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

回復 1# hong912
UserForm的程式碼
  1. Option Explicit                            '在模組層次中強迫每個在模組裏的變數都必須明確的宣告。
  2. Private Const 編號 = 3                     '資料庫的欄位列號
  3. Private Const ThePicture = "d:\ttt.gif"    '設立匯出圖片的路徑檔名
  4. Dim Ar(10), Sh As Worksheet
  5. 'Dim Ar()
  6. Private Sub UserForm_Initialize()          '表單初始化的預設事件程序
  7.     Dim I As Integer
  8.     Set Sh = Sheets("Sheet1")              '資料庫的工作表
  9.     With Sh
  10.         ComboBox1.List = .Range("a4", .[a4].End(xlDown)).Value '指定 ComboBox1的內容
  11.     End With
  12.     'Dim Ar()時可用下式
  13.     'Ar = Array(TextBox1, TextBox2, TextBox3, TextBox4, TextBox5, TextBox6, TextBox7, TextBox8, TextBox9, TextBox10, TextBox11)
  14.     For I = 0 To UBound(Ar)
  15.       Set Ar(I) = Me.Controls("TextBox" & I + 1) '陣列的元素設為TextBox (物件)
  16.     Next
  17.     Image1.PictureSizeMode = fmPictureSizeModeStretch
  18.     '參數fmPictureSizeModeStretch= 1 :調整圖片大小以填滿表單或活頁,此設定會造成圖片的水平與垂直方向比例被扭曲。
  19. End Sub
  20. Private Sub ComboBox1_Change()
  21.     Dim Sp As Picture, I As Integer
  22.     If ComboBox1.ListIndex > -1 Then   '選擇 ComboBox1的內容
  23.         For I = 0 To UBound(Ar)
  24.             Ar(I).Text = Sh.Cells(編號 + ComboBox1, I + 2)
  25.         Next
  26.     End If
  27.     With Sh
  28.         For Each Sp In .Pictures             '尋找N欄中的圖片,複製之
  29.             If Sp.TopLeftCell.Address(0, 0) = "N" & 編號 + ComboBox1 Then Sp.Copy: Exit For
  30.         Next
  31.         '利用圖表匯出存檔
  32.         With .ChartObjects.Add(1, 1, Sp.Width, Sp.Height)           '新增 圖表
  33.              .Chart.Paste                                           '貼上 圖片
  34.              .Chart.Export Filename:=ThePicture                     '匯出 圖片
  35.              .Delete                                                '刪除 圖表
  36.         End With
  37.     End With
  38.     Image1.Picture = LoadPicture(ThePicture)                         'Image1 指定圖片
  39. End Sub
  40. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)  '表單絕束時 預設事件程序
  41.     If Dir(ThePicture) <> "" Then Kill ThePicture                   '刪除 匯出的圖片
  42. End Sub
複製代碼

TOP

回復 2# GBKEE

GBKEE, 版大, 安好,
感謝回應, 已試用, 有小許問題, 但會試行解決, 若不成功, 便再請教, 真的衷心感謝謝, 祝健康快樂.. 感恩..
hong912

TOP

GBKEE 版大好,
大大的編寫很高深, 希望能從中學習, 現有2個問題請教, 附件,  內有說明, 先行謝過大大..祝快樂!!
b.rar (611.44 KB)
hong912

TOP

回復 4# hong912
試試看
  1. Private Sub UserForm_Click() '在表單沒有控制項的地方按下滑鼠左鍵的事件
  2. '1當圖片傳回表單,  圖片不清, 可有方辦解決 ':修改顯示背景圖片的方式
  3.     With Image1
  4.         If .PictureSizeMode = fmPictureSizeModeClip Then
  5.             .PictureSizeMode = fmPictureSizeModeStretch
  6.         ElseIf .PictureSizeMode = fmPictureSizeModeStretch Then
  7.             .PictureSizeMode = fmPictureSizeModeZoom
  8.         ElseIf .PictureSizeMode = fmPictureSizeModeZoom Then
  9.             .PictureSizeMode = fmPictureSizeModeClip
  10.         End If
  11.     End With
  12. ' [   常                                   數]  [值]  [ 說      明]
  13. 'fmPictureSizeModeClip          0    裁掉圖片多出來的部分 ( 預設 )。
  14. 'fmPictureSizeModeStretch    1    調整圖片大小以填滿表單或活頁,此設定會造成圖片的水平與垂直方向比例被扭曲。
  15. 'fmPictureSizeModeZoom      3     放大圖片,但不扭曲圖片水平與垂直方向的比例。
  16. End Sub
  17. Private Sub ComboBox1_Change()
  18.     Dim Sp As Picture, I As Integer
  19.     If ComboBox1.ListIndex > -1 Then   '選擇 ComboBox1的內容
  20.         For I = 0 To UBound(Ar)
  21.             If I <> UBound(Ar) Then
  22.                 Ar(I).Text = Sh.Cells(編號 + ComboBox1, I + 2)
  23.             Else
  24.                 '2, 在第11個TextBox11物件中, 可否做到把sheet1第11欄及12欄合拼顯示,如123aaa
  25.                  Ar(I).Text = Sh.Cells(編號 + ComboBox1, I + 2) & Sh.Cells(編號 + ComboBox1, I + 3)
  26.              End If
  27.         Next
  28.     End If
  29.     With Sh
  30.         For Each Sp In .Pictures             '尋找N欄中的圖片,複製之
  31.             If Sp.TopLeftCell.Address(0, 0) = "N" & 編號 + ComboBox1 Then Sp.Copy: Exit For
  32.         Next
  33.         '利用圖表匯出存檔
  34.         With .ChartObjects.Add(1, 1, Sp.Width, Sp.Height)           '新增 圖表
  35.              .Chart.Paste                                           '貼上 圖片
  36.              .Chart.Export Filename:=ThePicture                     '匯出 圖片
  37.              .Delete                                                '刪除 圖表
  38.         End With
  39.     End With
  40.     Image1.Picture = LoadPicture(ThePicture)                         'Image1 指定圖片
  41. End Sub
複製代碼

TOP

回復 5# GBKEE

衷心感謝GBKEE版大, 謝謝, 祝願快樂..
hong912

TOP

GBKEE版大, 安好
小弟有問題再度煩勞版大,  在大大寫的程式中,  不知是何原因,
在表單下拉編號中, 選擇了編號, 但却出現13及1004錯誤, 同時圖片亦不能顯示, 懇請大大協助,
再度煩勞, 敬請大大見諒, 最後祝願快樂
附件 KK.rar (526.38 KB)
hong912

TOP

QA1  ComboBox1 是文字型態還是數字型態.???

  多做多想多學習,少看少錯少迷途

  多做=多多練習,多多編寫。
  多想=想想為什麼人家程式要那樣寫,如果換成自己,又會怎寫。
  多學習=學習人家的發問並解答,學習人家的寫法

  少看=只看不做也枉然

TOP

回復 7# hong912
ComboBox1 增加一欄內容
  1. Private Sub UserForm_Initialize()          '表單初始化的預設事件程序
  2.     Dim I As Integer, e As Range
  3.     Set Sh = Sheets("Sheet1")              '資料庫的工作表
  4.     With Sh
  5.         For Each e In .Range("a4", .[a4].End(xlDown))  '指定 ComboBox1的內容
  6.             With ComboBox1                             'ComboBox1.ColumnCount=1 系統預設 顯示1欄資料
  7.                ' .ColumnCount=2                        '可顯示2欄資料
  8.                 .AddItem
  9.                 'AddItem 方法 在一個單列清單方塊或下拉式清單方塊中加入一個項目。在一個多列清單方塊或下拉式清單方塊中加入一行。
  10.                 .List(.ListCount - 1, 0) = e            'ComboBox第1欄 : 字串
  11.                 .List(.ListCount - 1, 1) = e.Row - 編號 'ComboBox第2欄 : 列號 1 - ....
  12.             End With
  13.         Next
  14.     End With
  15.     For I = 0 To UBound(Ar)
  16.       Set Ar(I) = Me.Controls("TextBox" & I + 1) '陣列的元素設為TextBox (物件)
  17.     Next
  18.     Image1.PictureSizeMode = fmPictureSizeModeStretch
  19.     '參數fmPictureSizeModeStretch= 1 :調整圖片大小以填滿表單或活頁,此設定會造成圖片的水平與垂直方向比例被扭曲。
  20. End Sub
  21. Private Sub ComboBox1_Change()
  22.     Dim Sp As Picture, I As Integer, R As Integer
  23.     If ComboBox1.ListIndex > -1 Then                    '選擇 ComboBox1的內容
  24.         R = ComboBox1.List(ComboBox1.ListIndex, 1)      'ComboBox第2欄 : 列號 1....
  25.         For I = 0 To UBound(Ar)
  26.             If I <> UBound(Ar) Then
  27.                 Ar(I).Text = Sh.Cells(編號 + R, I + 2)  '列號 : 編號 + R
  28.             Else
  29.                 '2, 在第11個TextBox11物件中, 可否做到把sheet1第11欄及12欄合拼顯示,如123aaa
  30.                  Ar(I).Text = Sh.Cells(編號 + R, I + 2) & Sh.Cells(編號 + R, I + 3)
  31.              End If
  32.         Next
  33.     End If
  34.     With Sh
  35.         For Each Sp In .Pictures             '尋找N欄中的圖片,複製之
  36.             If Sp.TopLeftCell.Address(0, 0) = "N" & 編號 + R Then Sp.Copy: Exit For
  37.         Next
  38.         '利用圖表匯出存檔
  39.         With .ChartObjects.Add(1, 1, Sp.Width, Sp.Height)           '新增 圖表
  40.              .Chart.Paste                                           '貼上 圖片
  41.              .Chart.Export Filename:=ThePicture                     '匯出 圖片
  42.              .Delete                                                '刪除 圖表
  43.         End With
  44.     End With
  45.     Image1.Picture = LoadPicture(ThePicture)                         'Image1 指定圖片
  46. End Sub
複製代碼

TOP

回復 9# GBKEE
感謝GBKEE版大再度回應, 待放工回家才能試用, 但覺得即時回應及說感謝, 是必須, 因這是一種禮貌, 再說聲感謝, 謝謝!!
hong912

TOP

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題