返回列表 上一主題 發帖

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

本帖最後由 GBKEE 於 2018-6-20 09:01 編輯

回復 14# jeffrey628litw
試試看
  1. Option Explicit                  '強制 模組的變數必須要 Dim的宣告,會使程式易於偵錯
  2. Dim Sh(1 To 2) As Worksheet, D As Object, xTempPicture As String  '模組頂端上 Dim的變數 可在UserForm1的全部程式中使用
  3. Dim AR_Image(), AR_TexTbox(), AR_Label(), xName As String
  4. Private Sub UserForm_Initialize()
  5.     Dim A As Range, S As String, E As Variant
  6.     Set Sh(1) = ThisWorkbook.Sheets("Database") '工作表如有變動時在此修改即可
  7.     Set Sh(2) = ThisWorkbook.Sheets.Add
  8.     AR_Image = Array(Image1, Image2, Image3, Image4)
  9.     AR_TexTbox = Array(TextBox1, TextBox2, TextBox3, TextBox4)
  10.     AR_Label = Array(Label1, Label4, Label6, Label8)
  11.     xTempPicture = "D:\NoPicture.jpg"
  12.     xName = "D:\temp.jpg"
  13.     照片Export Sh(1).Range("F2"), xTempPicture '置入"沒有圖片"檔 當作預設圖片及沒有圖片
  14.     Set D = CreateObject("Scripting.Dictionary")
  15.     For Each A In Sh(1).Range(Sh(1).[E3], Sh(1).[E3].End(xlDown))
  16.          S = Replace(Trim(A), vbLf, Space(1)) '換行字元 改成 Space(1)
  17.             If D.EXISTS(S) Then
  18.                 D(S) = D(S) & "," & A.Offset(, 1).Address
  19.             Else
  20.                 D(S) = A.Offset(, 1).Address
  21.             End If
  22.     Next
  23.     ComboBox1.List = D.KEYS
  24.     For E = 0 To UBound(AR_Image)
  25.         With AR_Image(E)            '設定圖片的顯示設模式
  26.             .Picture = LoadPicture(xTempPicture)
  27.             .PictureAlignment = fmPictureAlignmentCenter ' ***  0,1,2,3,4
  28.             .PictureSizeMode = 3 'fmPictureSizeModeClip  ' ***  0,1,3
  29.             '***** 請自行調整******
  30.             '**1.顯示圖片可以自動調整圖片大小在框框內:將Display Each Player Photo 這按鈕顯示的白色框框內圖片可以
  31.             '***自動顯示和 After Sieve Display Photo 白色框框內圖片自動調整大小及位置
  32.         End With
  33.         AR_TexTbox(E).MultiLine = True   '指定控制項是否接受並顯示多行文字。
  34.         AR_Label(E).WordWrap = False   '內容在行末是否自動換行
  35.     Next
  36. End Sub
  37. '***********************************************************************************
  38. '以下為開啟UserForm1時會自動開啟1工作表,有以下程式在關閉UserForm1時會自動關閉工作表
  39. Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  40.     Application.DisplayAlerts = False
  41.     Sh(2).Delete
  42.     Kill xTempPicture
  43.     Kill xName ' "D:\temp.jpg" '刪除暫存圖片
  44.     Application.DisplayAlerts = True
  45. End Sub
  46. '***********************************************************************************
  47. Private Sub ComboBox1_Change()
  48.     Dim A As Variant, i As Integer, S As String, ii As Integer
  49.     For i = 0 To UBound(AR_Label)
  50.         AR_Label(i).Caption = "沒有此圖片"
  51.         AR_TexTbox(i).Text = ""
  52.         AR_Image(i).Picture = LoadPicture(xTempPicture) '表單預設的圖片 為 Databasse 工作表中的 F3 儲存格圖片
  53.     Next
  54.     With ComboBox1
  55.         If .ListIndex = -1 Then Exit Sub
  56.         A = Split(D(.Value), ",")
  57.         For i = 0 To 3                    '如要增加或減少圖片則 修改 i = 0 To 3 後面的3的數量
  58.             If i <= UBound(A) Then
  59.                 S = A(i)
  60.                 If 圖片檢查(S) Then '
  61.                     AR_Image(ii).Picture = LoadPicture(xName)
  62.                     AR_Label(ii).Caption = Sh(1).Range(S).Offset(, -1).Text
  63.                     AR_TexTbox(ii).Text = Sh(1).Range(S).Offset(, -4).Text
  64.                     ii = ii + 1
  65.                 End If
  66.             End If
  67.         Next
  68.     End With
  69. End Sub
  70. Private Function 圖片檢查(xPicture As String) As Boolean
  71.     Dim S As Shape
  72.     For Each S In Sh(1).Shapes
  73.         '*************************************************
  74.         'Shape物件是照片且位置是D(ComboBox1.Value).Address)
  75.         If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
  76.             圖片檢查 = True
  77.             Exit For
  78.         End If
  79.         '***************************************************
  80.     Next
  81.     If 圖片檢查 = True Then 照片Export S, xName
  82.    
  83. End Function

  84. Private Sub 照片Export(P As Object, xName As String)
  85.     If xName <> "D:\temp.jpg" Then
  86.         P.CopyPicture
  87.     Else
  88.         P.Copy
  89.     End If
  90.     With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
  91.         .Chart.Paste '貼上圖片
  92.         .Chart.Export xName '匯出圖表,暫存圖片
  93.         .Delete '刪除圖表
  94.      End With
  95. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 13# jeffrey628litw


    這個問題下面寫錯,應該是
2.想要顯示圖片資料,以便超連結到Database 工作表,(不知是否用Textbox,是的話要如何寫VBA呢?)
1.希望將工作表Database 裡面將E欄對應B欄的資料撈出來,
到Textbox,
例如E3撈出B3到Textbox1
2.然後讓Textbox的文字超連結到工作表 Database

TOP

本帖最後由 jeffrey628litw 於 2018-6-18 09:46 編輯

回復 11# GBKEE


    G大 版大您好:我有自己改成可以撈4個圖片的檔案,如今有新的問題:
1.顯示圖片可以自動調整圖片大小在框框內:將Display Each Player Photo 這按鈕顯示的白色框框內圖片可以
自動顯示和 After Sieve Display Photo 白色框框內圖片自動調整大小及位置

    改成-->   同大小及位置

2.想要顯示圖片資料,以便超連結到Database 工作表,(不知是否用Textbox,是的話要如何寫VBA呢?)
1.希望將工作表Database 裡面將E欄對應B欄的資料撈出來,
到Textbox,
例如E3撈出B3到Textbox1
2.然後讓Database的文字超連結到工作表 Database


檔案雲端連結:http://webhd.xuite.net/_oops/jeffrey628litw/u05

謝謝版大的幫忙。

TOP

回復 11# GBKEE


    G大 版主您好:對於問題2 我有照您說的將哪一段程式隱藏就不會將沒有的資料對應的圖片,撈出下一張圖片了。
是我之前沒有跟您說清楚。

   這樣就全部解決了我的問題了,很感謝您這麼有耐心地回覆我的問題,再次感謝您。

TOP

本帖最後由 GBKEE 於 2018-6-17 11:04 編輯

回復 10# jeffrey628litw

2.    問題2.
撈的名字正確的圖案會出來,但會多撈下1欄圖片,沒有資料的應該撈的圖是F1儲存格的沒有圖片 (如果問題1您寫成預設圖片是Null那就不用撈F1儲存格)
這是 6#中的提問
我理解是ComboBox1所選的名字有圖案時 顯視在Image1,沒有圖案時Image1成預設圖片(給的程式是這樣寫沒錯)

關於Image2 這程式碼條件成立時才處理(這是我多做的處理嗎?)
  1. If UBound(A) = 0 And .ListIndex < .ListCount - 1 Then
複製代碼
UBound(A) = 0   **ComboBox1所選的名字在Database中是一的名字**
.ListIndex < .ListCount - 1   **所選的名字在ComboBox1的list中不是最後一個value(值)名字
將下個名字的圖片顯視在Image2

如不處理則開頭就處理了
  1. Private Sub ComboBox1_Change()
  2.     Dim A As Variant, i As Integer, S As String
  3.     Label1.Caption = "沒有此圖片"
  4.     Label4.Caption = "沒有此圖片"  '*******新增Label控制項
  5.     Image1.Picture = LoadPicture(xTempPicture) '表單預設的圖片
  6.     Image2.Picture = LoadPicture(xTempPicture) '表單預設的圖片
複製代碼
*****************************
3.    問題3.
撈同名字時例如大谷翔平,撈不出同樣名字但不同圖片,希望改善成Combobox1 (即下拉 Players Name)撈同名字時能撈出不同圖
UBound(A) > 0時-> **ComboBox1所選的名字在Database不是一的名字**
  1. A = Split(D(.Value), ",")
  2.         For i = 0 To 1
  3.             If i <= UBound(A) Then
  4.                 S = A(i)
  5.                 If 圖片檢查(S, IIf(i = 0, Image1, Image2)) Then Label1.Caption = .Value
  6.             End If
  7.         Next
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

本帖最後由 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

回復 7# GBKEE


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

    問題2和3還沒解決,

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

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

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

TOP

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

        靜思自在 : 閒人無樂趣,忙人無是非。
返回列表 上一主題