請問我這VBA哪裡有問題？為什麼會無法出現 424 無法找到物件呢?

jeffrey628litw

請問各位前輩先進

如何讓這檔案       能自動跳出多張圖片及對應資料)-英文版-02.rar (341.33 KB)

下載次數: 13

2018-6-12 19:34

         可以像右邊這檔案開啟圖檔呢?    20180611 VBA 讀取圖片 v.02.zip (43.52 KB)

下載次數: 9

2018-6-12 19:32

     右邊的檔案 圖片如下：

下載 (41.33 KB)

2018-6-12 19:36

請問我這VBA哪裡有問題？為什麼會無法出現 424 無法找到物件呢?

Private Sub ComboBox1_Change()
Dim a As Range
Application.ScreenUpdating = False
With Database
  Set a = .Columns("E").Find(ComboBox1, lookat:=xlWhole)
  Label1.Caption = a.Offset(, 1)
  a.Offset(, 1).CopyPicture '複製成圖片   a.Offset(, 1).  1為傳回上1行程式 a = .Columns("E").後1格儲存格的圖片
  With .ChartObjects.Add(1, 1, a.Offset(, 2).Width, a.Offset(, 2).Height) '新增圖表
    .Chart.Paste '貼上圖片
    .Chart.Export "D:\temp.jpg" '匯出圖表，暫存圖片
    .Delete '刪除圖表
  End With
  Image1.Picture = LoadPicture("D:\temp.jpg") '表單顯示圖片
  Kill "D:\temp.jpg" '刪除暫存圖片
End With
Application.ScreenUpdating = True
End Sub



Private Sub UserForm_Initialize()
Dim a As Range
Set d = CreateObject("Scripting.Dictionary")
With Database
   For Each a In .Range(.[E2], .[E2].End(xlDown))
      d(a.Value) = ""
   Next
End With
ComboBox1.List = d.keys
End Sub


-------------------------------------------------------------------
謝謝各位

GBKEE

回復 1# jeffrey628litw

試試看

1. Option Explicit                  '強制 模組的變數必須要 Dim的宣告,會使程式易於偵錯
   
2. Dim D As Object, Sh As Worksheet '模組頂端上 Dim的變數 可在UserForm1的全部程式中使用
   
3. Private Sub UserForm_Initialize()
   
4.     Dim A As Range, S As String
   
5.     Set D = CreateObject("Scripting.Dictionary")
   
6.     Set Sh = Sheets("Database") '工作表如有變動時在此修改即可
   
7.     'With Sheets("Database") ' 或是 With Sheet1
   
8.     With Sh
   
9.         For Each A In .Range(.[E2], .[E2].End(xlDown))
   
10.             '**************************
    
11.             'F10 ,F11 有換行字元 需修改
    
12.             '大 谷翔平
    
13.             'Shohei Ohtan
    
14.             '***************************
    
15.             S = Replace(Trim(A), vbLf, Space(1))  '換行字元 改成 Space(1)
    
16.             Set D(S) = Range(A.Offset(, 1).Address)
    
17.             'Debug.Print S, D(S).Address  '指令:檢視->及時視窗可看看
    
18.         Next
    
19.     End With
    
20.     ComboBox1.List = D.keys
    
21.     Label1.WordWrap = False   '內容在行末是否自動換行
    
22.     With Image1               '設定圖片的顯示設模式
    
23.         .PictureAlignment = fmPictureAlignmentCenter '2
    
24.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
25.     End With
    
26. End Sub
    
27. Private Sub ComboBox1_Change()
    
28.     Dim A As Range
    
29.     Label1.Caption = "沒有此圖片"
    
30.     Image1.Picture = LoadPicture("") '不顯示圖片
    
31.     'Image1.Visible = False      '或是隱藏
    
32.     If ComboBox1.ListIndex = -1 Then Exit Sub
    
33.     If 圖片檢查(D(ComboBox1.Value).Address) = False Then Exit Sub
    
34.     'Image1.Visible = True      '顯示
    
35. End Sub
    
36. Private Function 圖片檢查(xPicture As String) As Boolean
    
37.     Dim S As Shape, P As Object, xTop As Double
    
38.     For Each S In Sh.Shapes
    
39.         '*************************************************
    
40.         'Shape物件是照片且位置是D(ComboBox1.Value).Address)
    
41.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
    
42.             圖片檢查 = True
    
43.             S.Copy  '圖片複製
    
44.             Set P = S
    
45.             Exit For
    
46.         End If
    
47.         '***************************************************
    
48.     Next
    
49.     If 圖片檢查 = True Then
    
50.         With Sh
    
51.             Label1.Caption = ComboBox1
    
52.             With .ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
    
53.                 .Chart.Paste '貼上圖片
    
54.                 .Chart.Export "D:\temp.jpg" '匯出圖表，暫存圖片
    
55.                 .Delete '刪除圖表
    
56.             End With
    
57.             Image1.Picture = LoadPicture("D:\temp.jpg") '表單顯示圖片
    
58.             Kill "D:\temp.jpg" '刪除暫存圖片
    
59.         End With
    
60.     End If

複製代碼

jeffrey628litw

回復 2# GBKEE


    謝謝 G 超級版主的回覆，目前發現最後要加 End Function 就可以Run了，其他還在研究中，超級感謝您的幫忙。

jeffrey628litw

回復  jeffrey628litw

試試看
GBKEE 發表於 2018-6-13 08:26

    請問我想要按Display Photo按鈕後，
    下拉選單 Player Name
     選Mchael  Jordan 後可以出現
      Image1：為F2圖案
       Image2為F3圖案

       類似EBAY 篩選完有陣列圖表，類似下圖

下載 (109.84 KB)

2018-6-13 22:25

檔案在雲端  http://webhd.xuite.net/_oops/jeffrey628litw/c6x

GBKEE

回復 4# jeffrey628litw
試試看

1. Option Explicit                  '強制 模組的變數必須要 Dim的宣告,會使程式易於偵錯
   
2. Dim D As Object, Sh(1 To 2) As Worksheet '模組頂端上 Dim的變數 可在UserForm1的全部程式中使用
   
3. Dim xTempPicture As String
   
4. Private Sub UserForm_Initialize()
   
5.     Dim A As Range, S As String
   
6.     Set D = CreateObject("Scripting.Dictionary")
   
7.     Set Sh(1) = ThisWorkbook.Sheets("Database") '工作表如有變動時在此修改即可
   
8.     Set Sh(2) = ThisWorkbook.Sheets.Add
   
9.     xTempPicture = "D:\IE.jpg"
   
10.     匯入圖片   '載入表單畫面圖片
    
11.     With Sh(1)
    
12.         For Each A In .Range(.[E2], .[E2].End(xlDown))
    
13.             '**************************
    
14.             'F10 ,F11 有換行字元 需修改
    
15.             '大 谷翔平
    
16.             'Shohei Ohtan
    
17.             '***************************
    
18.             S = Replace(Trim(A), vbLf, Space(1)) '換行字元 改成 Space(1)
    
19.             Set D(S) = Range(A.Offset(, 1).Address)
    
20.             'Debug.Print S, D(S).Address  '指令:檢視->及時視窗可看看
    
21.         Next
    
22.     End With
    
23.     ComboBox1.List = D.KEYS
    
24.     Label1.WordWrap = False   '內容在行末是否自動換行
    
25.     With Image1               '設定圖片的顯示設模式
    
26.         .Picture = LoadPicture(xTempPicture)
    
27.         .PictureAlignment = fmPictureAlignmentCenter '2
    
28.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
29.     End With
    
30.     With Image2               '設定圖片的顯示設模式
    
31.         .Picture = LoadPicture(xTempPicture)
    
32.         .PictureAlignment = fmPictureAlignmentCenter '2
    
33.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
34.     End With
    
35. End Sub
    
36. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
37.     Application.DisplayAlerts = False
    
38.     Sh(2).Delete
    
39.     Kill xTempPicture
    
40.     Application.DisplayAlerts = True
    
41. End Sub
    
42. Private Sub ComboBox1_Change()
    
43.     Dim A As Range
    
44.     Label1.Caption = "沒有此圖片"
    
45.     Image1.Picture = LoadPicture(xTempPicture) '表單預設的圖片
    
46.     Image2.Picture = LoadPicture(xTempPicture) '表單預設的圖片
    
47.     'Image1.Visible = False      '或是隱藏
    
48.     With ComboBox1
    
49.         If .ListIndex = -1 Then Exit Sub
    
50.         圖片檢查 D(.List(.ListIndex)).Address, Image1
    
51.         If 圖片檢查(D(.Value).Address, Image1) Then Label1.Caption = ComboBox1
    
52.         If .ListIndex < .ListCount - 1 Then 圖片檢查 D(.List(.ListIndex + 1)).Address, Image2
    
53.     End With
    
54. End Sub
    
55. Private Function 圖片檢查(xPicture As String, xImage As Image) As Boolean
    
56.     Dim S As Shape, P As Object, xName As String
    
57.     For Each S In Sh(1).Shapes
    
58.         '*************************************************
    
59.         'Shape物件是照片且位置是D(ComboBox1.Value).Address)
    
60.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
    
61.             圖片檢查 = True
    
62.             Set P = S '.Copy '圖片複製
    
63.             Exit For
    
64.         End If
    
65.         '***************************************************
    
66.     Next
    
67.     If 圖片檢查 = True Then
    
68.         xName = "D:\temp.jpg"
    
69.         照片Export P, xName
    
70.         xImage.Picture = LoadPicture(xName) '表單顯示圖片
    
71.         Kill xName ' "D:\temp.jpg" '刪除暫存圖片
    
72.     End If
    
73.     End Function
    
74. Private Sub 照片Export(P As Object, xName As String)
    
75.     P.Copy
    
76.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
    
77.         .Chart.Paste '貼上圖片
    
78.         .Chart.Export xName '匯出圖表，暫存圖片
    
79.         .Delete '刪除圖表
    
80.      End With
    
81. End Sub
    
82. Sub 匯入圖片()
    
83.     Dim P As Picture
    
84.     With Sh(2)
    
85.         Set P = .Pictures.Insert("http://forum.twbts.com/templates/discuz6/images/logotop.png") '(工作表上插入照片)
    
86.         With [a1]                           '指定的儲存格
    
87.             P.Top = .Top                    '照片的右方在工作表上的位置
    
88.             P.Left = .Left                  '照片的右方在工作表上的位置
    
89.             .RowHeight = IIf(P.Height >= 409, 409, P.Height)        '調整儲存格高度=>照片的高度
    
90.             P.Height = IIf(P.Height >= 409, 409, P.Height)          '調整儲存格高度=>照片的高度
    
91.             If .Width < P.Width * (.ColumnWidth / .Width) Then   '下載照片的最大寬度
    
92.              .Width = P.Width * (.ColumnWidth / .Width)
    
93.             .ColumnWidth = P.Width * (.ColumnWidth / .Width)    '調整儲存格欄寬=>照片的寬度
    
94.             End If
    
95.        End With
    
96.      End With
    
97.     照片Export P, xTempPicture
    
98. End Sub

複製代碼

jeffrey628litw

回復 5# GBKEE


    超級版主您好：
我發現有3個問題，要麻煩您，問題如下：
1.    問題1.
預設圖案撈 F1儲存格圖案 (或者您這裡可以寫成預設圖片是Null)

下載 (45.08 KB)

2018-6-15 13:30

2.    問題2.
撈的名字正確的圖案會出來，但會多撈下1欄圖片，沒有資料的應該撈的圖是F1儲存格的沒有圖片 (如果問題1您寫成預設圖片是Null那就不用撈F1儲存格)

下載 (48 KB)

2018-6-15 13:31

3.    問題3.
撈同名字時例如大谷翔平，撈不出同樣名字但不同圖片

現狀：

下載 (43.3 KB)

2018-6-15 13:31

希望改善成Combobox1 (即下拉 Players Name)撈同名字時能撈出不同圖，如下圖：

下載 (43.98 KB)

2018-6-15 13:31

補充圖片給您放入F1儲存格或者寫程式路徑抓圖用：

下載 (8.92 KB)

2018-6-15 13:44

檔案在雲端：http://webhd.xuite.net/_oops/jeffrey628litw/l0e

GBKEE

回復 6# jeffrey628litw
再試試

1. Option Explicit                  '強制 模組的變數必須要 Dim的宣告,會使程式易於偵錯
   
2. Dim Sh(1 To 2) As Worksheet, xTempPicture As String '模組頂端上 Dim的變數 可在UserForm1的全部程式中使用
   
3. Private Sub UserForm_Initialize()
   
4.     Dim A As Range, i As Integer
   
5.     Set Sh(1) = ThisWorkbook.Sheets("Database") '工作表如有變動時在此修改即可
   
6.     Set Sh(2) = ThisWorkbook.Sheets.Add
   
7.     匯入圖片   '置入"沒有圖片"檔
   
8.      '不要用字典物件    Set D = CreateObject("Scripting.Dictionary")
   
9.     With ComboBox1
   
10.         For Each A In Sh(1).Range(Sh(1).[E3], Sh(1).[E3].End(xlDown))
    
11.            'ColumnCount 屬性 若將 ColumnCount 設成 0，顯示的行數便是 0；若設成 -1，便顯示所有的資料行。對一個非資料連結的資料來源而言，最多只能有 10 行 (0 到 9)。
    
12.             .ColumnCount = 2  '了解後,可不用此行程式碼?
    
13.             .AddItem
    
14.             .List(.ListCount - 1, 0) = A
    
15.             .List(.ListCount - 1, 1) = A.Offset(, 1).Address
    
16.         Next
    
17.     End With
    
18.     Label1.WordWrap = False   '內容在行末是否自動換行
    
19.     Label4.WordWrap = False   '*******新增Label控制項
    
20.    
    
21.     With Image1               '設定圖片的顯示設模式
    
22.         .Picture = LoadPicture(xTempPicture)
    
23.         .PictureAlignment = fmPictureAlignmentCenter '2
    
24.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
25.     End With
    
26.     With Image2               '設定圖片的顯示設模式
    
27.         .Picture = LoadPicture(xTempPicture)
    
28.         .PictureAlignment = fmPictureAlignmentCenter '2
    
29.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
30.     End With
    
31. End Sub
    
32. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
33.     Application.DisplayAlerts = False
    
34.     Sh(2).Delete
    
35.     Kill xTempPicture
    
36.     Application.DisplayAlerts = True
    
37. End Sub
    
38. Private Sub ComboBox1_Change()
    
39.     Dim A As Range
    
40.     Label1.Caption = "沒有此圖片"
    
41.     Label4.Caption = "沒有此圖片"  '*******新增Label控制項
    
42.     Image1.Picture = LoadPicture(xTempPicture) '表單預設的圖片
    
43.     Image2.Picture = LoadPicture(xTempPicture) '表單預設的圖片
    
44.     With ComboBox1
    
45.         If .ListIndex = -1 Then Exit Sub
    
46.         If 圖片檢查(.List(.ListIndex, 1), Image1) = True Then Label1.Caption = .Value
    
47.         If .ListIndex < .ListCount - 1 Then
    
48.             If 圖片檢查(.List(.ListIndex + 1, 1), Image2) Then Label4.Caption = .List(.ListIndex + 1, 0)
    
49.                                                                '*******新增Label控制項
    
50.         End If
    
51.     End With
    
52. End Sub
    
53. Private Function 圖片檢查(xPicture As String, xImage As Image) As Boolean
    
54.     Dim S As Shape, P As Object, xName As String
    
55.     For Each S In Sh(1).Shapes
    
56.         '*************************************************
    
57.         'Shape物件是照片且位置是D(ComboBox1.Value).Address)
    
58.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
    
59.             圖片檢查 = True
    
60.             Set P = S '.Copy '圖片複製
    
61.             Exit For
    
62.         End If
    
63.         '***************************************************
    
64.     Next
    
65.     If 圖片檢查 = True Then
    
66.         xName = "D:\temp.jpg"
    
67.         照片Export P, xName
    
68.         xImage.Picture = LoadPicture(xName) '表單顯示圖片
    
69.         Kill xName ' "D:\temp.jpg" '刪除暫存圖片
    
70.     End If
    
71.     End Function
    
72. Private Sub 照片Export(P As Object, xName As String)
    
73.     P.Copy
    
74.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
    
75.         .Chart.Paste '貼上圖片
    
76.         .Chart.Export xName '匯出圖表，暫存圖片
    
77.         .Delete '刪除圖表
    
78.      End With
    
79. End Sub
    
80. Sub 匯入圖片()
    
81.     Dim P As Range
    
82.     xTempPicture = "D:\NoPicture.jpg"
    
83.     Set P = Sh(1).[f2]
    
84.     P.CopyPicture
    
85.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
    
86.         .Chart.Paste '貼上圖片
    
87.         .Chart.Export xTempPicture '匯出圖表，暫存圖片
    
88.         .Delete '刪除圖表
    
89.      End With
    
90. End Sub

複製代碼

jeffrey628litw

回復 7# GBKEE


    G大 超級版主您好，我看您已經有將我問題1解決了，另外要程式中說明要新增 Lable4 我也新增了，

    問題2和3還沒解決，

   接下來，
程式的邏輯是要依據撈出的Lable4 如果結果同Lable1的字串，則撈出圖片，否則撈出Null的圖片嗎?

   是這樣的話請問要如何寫呢? 因為我對於VBA實在幾乎完全不了解，能否請您幫忙一點一點解給我看，我慢慢學呢?
謝謝您。

檔案在雲端：http://webhd.xuite.net/_oops/jeffrey628litw/wyh

GBKEE

回復 8# jeffrey628litw
對於VBA不了解,可多看看論壇的主題及VBA上說明,並多練習,會進步的
不懂可提問.內容讓人看懂就會得到回覆(義務性)

如有不符,請再詳加說明

1. Option Explicit                  '強制 模組的變數必須要 Dim的宣告,會使程式易於偵錯
   
2. Dim Sh(1 To 2) As Worksheet, D As Object, xTempPicture As String  '模組頂端上 Dim的變數 可在UserForm1的全部程式中使用
   
3. Private Sub UserForm_Initialize()
   
4.     Dim A As Range, S As String
   
5.     Set Sh(1) = ThisWorkbook.Sheets("Database") '工作表如有變動時在此修改即可
   
6.     Set Sh(2) = ThisWorkbook.Sheets.Add
   
7.      xTempPicture = "D:\NoPicture.jpg"
   
8.     照片Export Sh(1).Range("F2"), xTempPicture '置入"沒有圖片"檔
   
9.     Set D = CreateObject("Scripting.Dictionary")
   
10.     For Each A In Sh(1).Range(Sh(1).[E3], Sh(1).[E3].End(xlDown))
    
11.          S = Replace(Trim(A), vbLf, Space(1)) '換行字元 改成 Space(1)
    
12.             If D.EXISTS(S) Then
    
13.                 D(S) = D(S) & "," & A.Offset(, 1).Address
    
14.             Else
    
15.                 D(S) = A.Offset(, 1).Address
    
16.             End If
    
17.     Next
    
18.     ComboBox1.List = D.KEYS
    
19.     Label1.WordWrap = False   '內容在行末是否自動換行
    
20.     Label4.WordWrap = False   '*******新增Label控制項
    
21.     With Image1               '設定圖片的顯示設模式
    
22.         .Picture = LoadPicture(xTempPicture)
    
23.         .PictureAlignment = fmPictureAlignmentCenter '2
    
24.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
25.     End With
    
26.     With Image2               '設定圖片的顯示設模式
    
27.         .Picture = LoadPicture(xTempPicture)
    
28.         .PictureAlignment = fmPictureAlignmentCenter '2
    
29.         .PictureSizeMode = fmPictureSizeModeClip     '0
    
30.     End With
    
31. End Sub
    
32. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
33.     Application.DisplayAlerts = False
    
34.     Sh(2).Delete
    
35.     Kill xTempPicture
    
36.     Application.DisplayAlerts = True
    
37. End Sub
    
38. Private Sub ComboBox1_Change()
    
39.     Dim A As Variant, i As Integer, S As String
    
40.     Label1.Caption = "沒有此圖片"
    
41.     Label4.Caption = "沒有此圖片"  '*******新增Label控制項
    
42.     Image1.Picture = LoadPicture(xTempPicture) '表單預設的圖片
    
43.     Image2.Picture = LoadPicture(xTempPicture) '表單預設的圖片
    
44.     With ComboBox1
    
45.         If .ListIndex = -1 Then Exit Sub
    
46.         A = Split(D(.Value), ",")
    
47.         For i = 0 To 1
    
48.             If i <= UBound(A) Then
    
49.                 S = A(i)
    
50.                 If 圖片檢查(S, IIf(i = 0, Image1, Image2)) Then Label1.Caption = .Value
    
51.             End If
    
52.         Next
    
53.         Label4.Visible = UBound(A) = 0   '有相同的 Player Name 則不顯示
    
54.         If UBound(A) = 0 And .ListIndex < .ListCount - 1 Then
    
55.             A = Split(D(.List(.ListIndex + 1)), ",")
    
56.             S = A(0)
    
57.             If 圖片檢查(S, Image2) Then Label4.Caption = .List(.ListIndex + 1, 0)
    
58.                                                                '*******新增Label控制項
    
59.         End If
    
60.     End With
    
61. End Sub
    
62. Private Function 圖片檢查(xPicture As String, xImage As Image) As Boolean
    
63.     Dim S As Shape, xName As String
    
64.     For Each S In Sh(1).Shapes
    
65.         '*************************************************
    
66.         'Shape物件是照片且位置是D(ComboBox1.Value).Address)
    
67.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
    
68.             圖片檢查 = True
    
69.             Exit For
    
70.         End If
    
71.         '***************************************************
    
72.     Next
    
73.     If 圖片檢查 = True Then
    
74.         xName = "D:\temp.jpg"
    
75.         照片Export S, xName
    
76.         xImage.Picture = LoadPicture(xName) '表單顯示圖片
    
77.         Kill xName ' "D:\temp.jpg" '刪除暫存圖片
    
78.     End If
    
79.     End Function
    
80. Private Sub 照片Export(P As Object, xName As String)
    
81.     If xName <> "D:\temp.jpg" Then
    
82.         P.CopyPicture
    
83.     Else
    
84.         P.Copy
    
85.     End If
    
86.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
    
87.         .Chart.Paste '貼上圖片
    
88.         .Chart.Export xName '匯出圖表，暫存圖片
    
89.         .Delete '刪除圖表
    
90.      End With
    
91. End Sub

複製代碼

jeffrey628litw

回復 9# GBKEE


    G大 版主您好：我看了問題3也解決了，剩下問題2，這邏輯是要寫

當Lable1 And Lable4 不為空時且不相同，則顯示2張圖片到Image1 和Image4，
否則 當Lable1不等於 Label4，則顯示Image1 且 Image4為空
否則 當Label1等於空，Lable4不等於空，則顯示Image1為空 且顯示 Image4的圖片

是這樣子嗎? 是的話程式要怎麼寫呢?再請您賜教，謝謝。

雲端檔案：http://webhd.xuite.net/_oops/jeffrey628litw/gdn