123
返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2018-6-17 10:50 | 只看該作者
本帖最後由 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

jeffrey628litw

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

2011兔年全勤獎章
12#
發表於 2018-6-17 11:36 | 只看該作者
回復 11# GBKEE


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

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

TOP

jeffrey628litw

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

2011兔年全勤獎章
13#
發表於 2018-6-18 09:43 | 只看該作者
本帖最後由 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

jeffrey628litw

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

2011兔年全勤獎章
14#
發表於 2018-6-18 10:04 | 只看該作者
回復 13# jeffrey628litw


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

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
15#
發表於 2018-6-18 12:15 | 只看該作者
本帖最後由 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

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

TOP

jeffrey628litw

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

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


    G大 版主您好：出現下面的情況，我查不到如何解?

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
17#
發表於 2018-6-18 15:16 | 只看該作者
回復 16# jeffrey628litw

查看這程序上的程式碼有無缺失掉
  1. Private Sub 照片Export(P As Object, xName As String)
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

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

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


    G大 版主您好  ：我整理好檔案了，已經符合我的想法了，非常感謝您的大力幫忙，我也將檔案放在這裡分享，再次感謝。

   雲端檔案分享：http://webhd.xuite.net/_oops/jeffrey628litw/uxz

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
19#
發表於 2018-6-20 09:06 | 只看該作者
回復 18# jeffrey628litw
  [14] 大谷翔平 Shohei Ohtani球棒卡球棒頂端   F15  沒有圖片
所以修改 15#的程式碼,會更為貼切
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

jeffrey628litw

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

2011兔年全勤獎章
20#
發表於 2018-6-20 16:26 | 只看該作者
回復 19# GBKEE


    G大 版主您好：我不懂您的意思，我F15儲存格是故意不放圖片要測試撈不撈的出預設的圖片(沒有圖片)

TOP

        靜思自在 : 【時間成就一切】時間可以造就人格，可以成就事業，也可以儲積功德。
123
返回列表 上一主題