Board logo

標題: 一個查詢的表單, [打印本頁]
作者: hong912    時間: 2012-9-15 11:24     標題: 一個查詢的表單,

各版主及各大大, 安好, 小弟初次到這論壇, 亦初次發問, 希望能得到大大回應, 更希望從回應中學習, 現把檔案上傳, 先行謝過各位, 謝謝!!
[attach]12507[/attach]
作者: GBKEE    時間: 2012-9-15 17:16

回復 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
複製代碼
作者: hong912    時間: 2012-9-15 18:46

回復 2# GBKEE

GBKEE, 版大, 安好,
感謝回應, 已試用, 有小許問題, 但會試行解決, 若不成功, 便再請教, 真的衷心感謝謝, 祝健康快樂.. 感恩..
作者: hong912    時間: 2012-9-16 14:28

GBKEE 版大好,
大大的編寫很高深, 希望能從中學習, 現有2個問題請教, 附件,  內有說明, 先行謝過大大..祝快樂!!
[attach]12515[/attach]
作者: GBKEE    時間: 2012-9-16 16:07

回復 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
複製代碼
作者: hong912    時間: 2012-9-16 21:39

回復 5# GBKEE

衷心感謝GBKEE版大, 謝謝, 祝願快樂..
作者: hong912    時間: 2012-9-21 16:20

GBKEE版大, 安好
小弟有問題再度煩勞版大,  在大大寫的程式中,  不知是何原因,
在表單下拉編號中, 選擇了編號, 但却出現13及1004錯誤, 同時圖片亦不能顯示, 懇請大大協助,
再度煩勞, 敬請大大見諒, 最後祝願快樂
附件 [attach]12580[/attach]
作者: mark15jill    時間: 2012-9-21 16:51

QA1  ComboBox1 是文字型態還是數字型態.???
作者: GBKEE    時間: 2012-9-21 17:03

回復 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
複製代碼
作者: hong912    時間: 2012-9-21 17:39

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

回復 9# GBKEE
GBKEE版大, 好  先行謝過版大回應, 但出現下列問題,
程式貼到檔案工作上, 從下拉選擇編號後,      (  For Each Sp In .Pictures             '尋找N欄中的圖片,複製之 ), 這行顯示黃色,   到底問題在於哪裡, 希望大大能協助, 謝謝

    Private Sub ComboBox1_Change()

    Dim Sp As Picture, I As Integer, R As Integer

    If ComboBox1.ListIndex > -1 Then                    '選擇 ComboBox1的內容

        R = ComboBox1.List(ComboBox1.ListIndex, 1)      'ComboBox第2欄 : 列號 1....

        For I = 0 To UBound(Ar)

            If I <> UBound(Ar) Then

                Ar(I).Text = Sh.Cells(編號 + R, I + 2)  '列號 : 編號 + R

            Else

                '2, 在第11個TextBox11物件中, 可否做到把sheet1第11欄及12欄合拼顯示,如123aaa

                 Ar(I).Text = Sh.Cells(編號 + R, I + 2) & Sh.Cells(編號 + R, I + 3)

             End If

        Next

    End If

    With Sh

        For Each Sp In .Pictures             '尋找N欄中的圖片,複製之

            If Sp.TopLeftCell.Address(0, 0) = "N" & 編號 + R Then Sp.Copy: Exit For

        Next

        '利用圖表匯出存檔

        With .ChartObjects.Add(1, 1, Sp.Width, Sp.Height)           '新增 圖表

             .Chart.Paste                                           '貼上 圖片

             .Chart.Export Filename:=ThePicture                     '匯出 圖片

             .Delete                                                '刪除 圖表

        End With

    End With

    Image1.Picture = LoadPicture(ThePicture)                         'Image1 指定圖片

End Sub
作者: Hsieh    時間: 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
複製代碼
[attach]12586[/attach]
作者: 317    時間: 2012-9-22 07:33

回復 12# Hsieh

Hsieh版大, 早晨
謝謝回應, 一早起床, 看到回應, 的確很高興, 但趕開工, 時間迫切, 要到夜晚才能試用, 感謝回應, 祝願快樂, 謝謝!!
作者: hong912    時間: 2012-9-22 07:43

回復 12# Hsieh

可以運行了, 謝謝大大
作者: GBKEE    時間: 2012-9-22 14:30

回復 11# hong912
9# 的程式碼, 是依據你7# 附檔修改的,我執行時並沒有你提到的錯誤
請查看你檔案中的圖片是否有移動,離開7# 附檔的位置.
作者: hong912    時間: 2012-9-22 22:28

回復 15# GBKEE
GBKEE版大,
謝謝大大再度提示, 的確最初沒為意最下列儲存格有二列是沒有圖片, 多謝大大提示, 感恩..謝謝!!
作者: 317    時間: 2012-9-23 10:02

昨晚試過, 很合用, 先謝過發問的樓主,
在此更向CBKEE及Hsieh两位超級大大致謝, 感謝两位長久的教導, 過去及現在, 令小妹領會了不小,
謝謝謝!!
作者: hong912    時間: 2012-9-23 18:44

GBKEE 版大, 安好
這两天細看大大所寫的程式, 老實說, 只知道是點點, 同時亦發現一個圖片問題,
希望大大能協助, 在大大的程式中是可以運行, 但當遇上一些不支援的圖片格式
如png, 便會彈出下列提示,
執行階段錯誤91, 沒有設定物件變數或with區塊變數,
大大, 可否修改程式至任何圖片格式都可使用,  煩勞大大, 在此先行謝謝謝!!

Option Explicit                            '在模組層次中強迫每個在模組裏的變數都必須明確的宣告。

Private Const 編號 = 3                     '資料庫的欄位列號

Private Const ThePicture = "d:\ttt.gif"    '設立匯出圖片的路徑檔名

Dim Ar(10), Sh As Worksheet
Private Sub UserForm_Initialize()          '表單初始化的預設事件程序

    Dim I As Integer, e As Range

    Set Sh = Sheets("Sheet1")              '資料庫的工作表

    With Sh

        For Each e In .Range("a4", .[a4].End(xlDown))  '指定 ComboBox1的內容

            With ComboBox1                             'ComboBox1.ColumnCount=1 系統預設 顯示1欄資料

               ' .ColumnCount=2                        '可顯示2欄資料

                .AddItem

                'AddItem 方法 在一個單列清單方塊或下拉式清單方塊中加入一個項目。在一個多列清單方塊或下拉式清單方塊中加入一行。

                .List(.ListCount - 1, 0) = e            'ComboBox第1欄 : 字串

                .List(.ListCount - 1, 1) = e.Row - 編號 'ComboBox第2欄 : 列號 1 - ....

            End With

        Next

    End With

    For I = 0 To UBound(Ar)

      Set Ar(I) = Me.Controls("TextBox" & I + 1) '陣列的元素設為TextBox (物件)

    Next

    Image1.PictureSizeMode = fmPictureSizeModeStretch

    '參數fmPictureSizeModeStretch= 1 :調整圖片大小以填滿表單或活頁，此設定會造成圖片的水平與垂直方向比例被扭曲。

End Sub
Private Sub UserForm_Click() '在表單沒有控制項的地方按下滑鼠左鍵的事件

'1當圖片傳回表單,  圖片不清, 可有方辦解決 ':修改顯示背景圖片的方式

   With Image1

       If .PictureSizeMode = fmPictureSizeModeClip Then

           .PictureSizeMode = fmPictureSizeModeStretch

       ElseIf .PictureSizeMode = fmPictureSizeModeStretch Then

           .PictureSizeMode = fmPictureSizeModeZoom

       ElseIf .PictureSizeMode = fmPictureSizeModeZoom Then

           .PictureSizeMode = fmPictureSizeModeClip

       End If

    End With

' [   常                                   數]  [值]  [ 說      明]

'fmPictureSizeModeClip          0    裁掉圖片多出來的部分 ( 預設 )。

'fmPictureSizeModeStretch    1    調整圖片大小以填滿表單或活頁，此設定會造成圖片的水平與垂直方向比例被扭曲。

'fmPictureSizeModeZoom      3     放大圖片，但不扭曲圖片水平與垂直方向的比例。

End Sub
Private Sub ComboBox1_Change()

    Dim Sp As Picture, I As Integer, R As Integer

    If ComboBox1.ListIndex > -1 Then                    '選擇 ComboBox1的內容

        R = ComboBox1.List(ComboBox1.ListIndex, 1)      'ComboBox第2欄 : 列號 1....

        For I = 0 To UBound(Ar)

            If I <> UBound(Ar) Then

                Ar(I).Text = Sh.Cells(編號 + R, I + 2)  '列號 : 編號 + R

            Else

                '2, 在第11個TextBox11物件中, 可否做到把sheet1第11欄及12欄合拼顯示,如123aaa

                 Ar(I).Text = Sh.Cells(編號 + R, I + 2) & Sh.Cells(編號 + R, I + 3)

             End If

        Next

    End If

    With Sh

        For Each Sp In .Pictures             '尋找N欄中的圖片,複製之

            If Sp.TopLeftCell.Address(0, 0) = "N" & 編號 + R Then Sp.Copy: Exit For

        Next

        '利用圖表匯出存檔

        With .ChartObjects.Add(1, 1, Sp.Width, Sp.Height)           '新增 圖表

             .Chart.Paste                                           '貼上 圖片

             .Chart.Export Filename:=ThePicture                     '匯出 圖片

             .Delete                                                '刪除 圖表

        End With

    End With

    Image1.Picture = LoadPicture(ThePicture)                         'Image1 指定圖片

End Sub
作者: Hsieh    時間: 2012-9-23 23:41

回復 18# hong912

請上傳無法讀取的問題檔案
應該只要是能插入到工作表中的圖片均可讀取才對
作者: hong912    時間: 2012-9-24 08:15

回復 19# Hsieh
Hsieh版大, 早晨
昨夜自行研究了很久, 用相機及手機攝影了照片及上網下載圖片試試, 並沒有問題, 再了解圖片格式, 也有不同格式, 同樣地能傳回圖片, 後來小弟把不能傳回的圖片剪下放進圖像中心, 再從圖像中心貼回檔案內, 問題竟解決,
謝過大大回應, 感恩..
作者: 周大偉    時間: 2012-9-25 21:54

回復 12# Hsieh
Hsieh版主,
今天再到這論壇, 看到這篇文章, 下載了希望日後能從中學習,
有一問題想請教版大, 當從下拉中選定編號, 便出現執行錯誤449, 程式中有黃色錯誤處, 大大, 到底是何問題, 請教..感恩..
[attach]12606[/attach]
作者: Hsieh    時間: 2012-9-25 22:31

回復 21# 周大偉
沒注意到2003以外版本，圖表新增時，不可忽略left與top引數
With Sheet1.ChartObjects.Add(1, 1, PicAr(k).Width, PicAr(k).Height)
作者: 周大偉    時間: 2012-9-25 22:56

回復 22# Hsieh

謝謝大大指導, 把程式碼換上, 問題便出現下列情況,
執行錯誤階段76, Chart.Export fs '以圖表匯成圖片
請大大教導..感恩..
作者: Hsieh    時間: 2012-9-25 23:04

回復 23# 周大偉


    可能是
Private Const fs = "E:\temp.jpg" '暫存圖片目錄位置
這個目錄位置不存在
作者: 周大偉    時間: 2012-9-25 23:38

本帖最後由 周大偉 於 2012-9-25 23:40 編輯

回復 24# Hsieh
大大, 就煩勞了, 但有一個現像, 當選定編號後, 便出現, 執行錯誤階段76, Chart.Export fs '以圖表匯成圖片, 但圖片却貼上工作表1, a1位置, 現上傳附件, 請大大教導,
[attach]12607[/attach][
作者: 317    時間: 2012-9-27 23:54

回復 24# Hsieh
hsieh版大, 安好,
這個目錄位置不存在, 這到底是指, 因小妹理解, 作業系統中一般辦公室軟件都會有圖像檔, 而小妹也能運用上述程式, 而大大回應上述樓主是指這個目錄位置不存在, 希望大大能解說一下, 同時在這情況下, 可有方辦彌補..謝謝!!
作者: Hsieh    時間: 2012-9-28 07:16

回復 26# 317


    可能是電腦中沒有E槽分割吧
作者: GBKEE    時間: 2012-9-28 16:40

回復 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
複製代碼
作者: 周大偉    時間: 2012-9-28 19:10

回復 28# GBKEE
先謝謝大大,
     fs = CurDir & "\temp.jpg"  '*** 這裡修改為當下的目錄 ( CurDir )為暫存圖片目錄位置 ***
這句的意思是指目錄位置, 是指, 如c盤d盤, 或檔案路徑, 大大可否指導, 謝謝!!
作者: Hsieh    時間: 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
複製代碼
作者: GBKEE    時間: 2012-9-29 16:34

回復 29# 周大偉
CurDir: 傳回前目錄位置
當使用開啟舊檔指令: 所看到的目錄位置
作者: 周大偉    時間: 2012-9-29 20:24

在此謝過hsieh及gbkee两位超版大, 衷心感謝, 希望能從中學習, 最後祝願中秋節快樂, 謝謝!!
作者: hong912    時間: 2012-9-30 11:09

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

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

回復 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    時間: 2012-9-30 16:14

回復 34# GBKEE

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)