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

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 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
試試看

Option Explicit '強制模組的變數必須要 Dim的宣告,會使程式易於偵錯
Dim D As Object, Sh(1 To 2) As Worksheet '模組頂端上 Dim的變數可在UserForm1的全部程式中使用
Dim xTempPicture As String
Private Sub UserForm_Initialize()
Dim A As Range, S As String
Set D = CreateObject("Scripting.Dictionary")
Set Sh(1) = ThisWorkbook.Sheets("Database") '工作表如有變動時在此修改即可
Set Sh(2) = ThisWorkbook.Sheets.Add
xTempPicture = "D:\IE.jpg"
匯入圖片 '載入表單畫面圖片
With Sh(1)
For Each A In .Range(.[E2], .[E2].End(xlDown))
'**************************
'F10 ,F11 有換行字元需修改
'大谷翔平
'Shohei Ohtan
'***************************
S = Replace(Trim(A), vbLf, Space(1)) '換行字元改成 Space(1)
Set D(S) = Range(A.Offset(, 1).Address)
'Debug.Print S, D(S).Address '指令:檢視->及時視窗可看看
Next
End With
ComboBox1.List = D.KEYS
Label1.WordWrap = False '內容在行末是否自動換行
With Image1 '設定圖片的顯示設模式
.Picture = LoadPicture(xTempPicture)
.PictureAlignment = fmPictureAlignmentCenter '2
.PictureSizeMode = fmPictureSizeModeClip '0
End With
With Image2 '設定圖片的顯示設模式
.Picture = LoadPicture(xTempPicture)
.PictureAlignment = fmPictureAlignmentCenter '2
.PictureSizeMode = fmPictureSizeModeClip '0
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Application.DisplayAlerts = False
Sh(2).Delete
Kill xTempPicture
Application.DisplayAlerts = True
End Sub
Private Sub ComboBox1_Change()
Dim A As Range
Label1.Caption = "沒有此圖片"
Image1.Picture = LoadPicture(xTempPicture) '表單預設的圖片
Image2.Picture = LoadPicture(xTempPicture) '表單預設的圖片
'Image1.Visible = False '或是隱藏
With ComboBox1
If .ListIndex = -1 Then Exit Sub
圖片檢查 D(.List(.ListIndex)).Address, Image1
If 圖片檢查(D(.Value).Address, Image1) Then Label1.Caption = ComboBox1
If .ListIndex < .ListCount - 1 Then 圖片檢查 D(.List(.ListIndex + 1)).Address, Image2
End With
End Sub
Private Function 圖片檢查(xPicture As String, xImage As Image) As Boolean
Dim S As Shape, P As Object, xName As String
For Each S In Sh(1).Shapes
'*************************************************
'Shape物件是照片且位置是D(ComboBox1.Value).Address)
If S.Type = msoPicture And S.TopLeftCell.Address = xPicture Then
圖片檢查 = True
Set P = S '.Copy '圖片複製
Exit For
End If
'***************************************************
Next
If 圖片檢查 = True Then
xName = "D:\temp.jpg"
照片Export P, xName
xImage.Picture = LoadPicture(xName) '表單顯示圖片
Kill xName ' "D:\temp.jpg" '刪除暫存圖片
End If
End Function
Private Sub 照片Export(P As Object, xName As String)
P.Copy
With Sh(2).ChartObjects.Add(1, 1, P.Width, P.Height) '新增圖表
.Chart.Paste '貼上圖片
.Chart.Export xName '匯出圖表，暫存圖片
.Delete '刪除圖表
End With
End Sub
Sub 匯入圖片()
Dim P As Picture
With Sh(2)
Set P = .Pictures.Insert("http://forum.twbts.com/templates/discuz6/images/logotop.png") '(工作表上插入照片)
With [a1] '指定的儲存格
P.Top = .Top '照片的右方在工作表上的位置
P.Left = .Left '照片的右方在工作表上的位置
.RowHeight = IIf(P.Height >= 409, 409, P.Height) '調整儲存格高度=>照片的高度
P.Height = IIf(P.Height >= 409, 409, P.Height) '調整儲存格高度=>照片的高度
If .Width < P.Width * (.ColumnWidth / .Width) Then '下載照片的最大寬度
.Width = P.Width * (.ColumnWidth / .Width)
.ColumnWidth = P.Width * (.ColumnWidth / .Width) '調整儲存格欄寬=>照片的寬度
End If
End With
End With
照片Export P, xTempPicture
End Sub