返回列表 上一主題 發帖

一個查詢的表單,

回復 5# GBKEE

衷心感謝GBKEE版大, 謝謝, 祝願快樂..
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

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

TOP

回復 2# GBKEE

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

TOP

回復 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

        靜思自在 : 並非有錢魷是快樂,問心無愧心最安。
返回列表 上一主題