123
返回列表 上一主題 發帖

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

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
20  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2024-9-16 

2011兔年全勤獎章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-6-12 19:36 | 只看該作者

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

請問各位前輩先進

如何讓這檔案       能自動跳出多張圖片及對應資料)-英文版-02.rar (341.33 KB)          可以像右邊這檔案開啟圖檔呢?    20180611 VBA 讀取圖片 v.02.zip (43.52 KB)


     右邊的檔案 圖片如下：



請問我這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

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2018-6-13 08:26 | 只看該作者
本帖最後由 GBKEE 於 2018-6-13 08:27 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
20  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2024-9-16 

2011兔年全勤獎章
3#
發表於 2018-6-13 14:11 | 只看該作者
回復 2# GBKEE


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

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
20  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2024-9-16 

2011兔年全勤獎章
4#
發表於 2018-6-13 22:26 | 只看該作者
回復  jeffrey628litw

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



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

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



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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2018-6-15 09:31 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
20  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2024-9-16 

2011兔年全勤獎章
6#
發表於 2018-6-15 13:32 | 只看該作者
本帖最後由 jeffrey628litw 於 2018-6-15 13:45 編輯

回復 5# GBKEE


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


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


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

現狀：

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



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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
7#
發表於 2018-6-15 16:39 | 只看該作者
回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
20  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2024-9-16 

2011兔年全勤獎章
8#
發表於 2018-6-15 18:31 | 只看該作者
回復 7# GBKEE


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

    問題2和3還沒解決，

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

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

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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2018-6-16 06:22 | 只看該作者
本帖最後由 GBKEE 於 2018-6-16 06:26 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

帖子
228 
主題
62 
精華
0 
積分
364 
點名
20  
作業系統
Win 10 
軟體版本
Office 2007 & 2010 
閱讀權限
20 
性別
男 
註冊時間
2011-3-5 
最後登錄
2024-9-16 

2011兔年全勤獎章
10#
發表於 2018-6-16 11:22 | 只看該作者
回復 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

TOP

        靜思自在 : 時時好心就是時時好日。
123
返回列表 上一主題