- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2014-7-15 18:24
| 只看該作者
本帖最後由 GBKEE 於 2014-7-15 18:29 編輯
回復 3# Jared
試試看- Option Explicit
- Sub Ex()
- Dim i As Integer, R As Integer, C As Integer
- Dim S As String
- R = 10 '第10個 Image 列的位置
- C = 1 '第10個 Image 欗的位置
- With ActiveSheet
- i = 10
- On Error Resume Next
- Do
- .OLEObjects("Image" & i).Delete
- i = i + 1
- Loop Until Err <> 0
- Err.Clear
- On Error GoTo 0
- S = Dir(ThisWorkbook.Path & "\Test\*.gif")
- i = 0
- Do While S <> ""
- i = i + 1
- If i <= 9 Then
- .OLEObjects("Image" & i).Object.Picture = LoadPicture(ThisWorkbook.Path & "\Test\" & S)
- Else
- With .OLEObjects.Add(ClassType:="Forms.Image.1", Left:=.Cells(R, C).Left, Top:=.Cells(R, C).Top, Width:=.Cells(R, C).Resize(, 2).Width, Height:=.Cells(R, C).Resize(3).Height)
- .Name = "Image" & i
- .Object.Picture = LoadPicture(ThisWorkbook.Path & "\Test\" & S)
- R = R
- C = C + 2 'Image 有3欄(欄寬=2)
- If C > 6 Then
- C = 1
- R = R + 3 'Image 有3列(列高=3列)
- End If
- End With
- End If
- S = Dir
- Loop
- i = i + 1
- On Error Resume Next
- Do
- If i <= 9 Then
- .OLEObjects("Image" & i).Object.Picture = LoadPicture("")
- End If
- i = i + 1
- Loop Until Err <> 0
- End With
- End Sub
複製代碼 |
|