- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
13#
發表於 2012-12-15 11:28
| 只看該作者
回復 11# whirlwind963 - Option Explicit
- Sub Ex()
- Dim j As Integer, MyPath As String, MyFile As String, k, L
- For k = 1 To 2 'A,B欄
- For L = 4 To 5 'D,E欄
- j = 2
- While Cells(j, "C") <> "" 'C欄為檔名
- MyPath = Cells(j, k) 'A欄,B欄為位址
- If UCase(Cells(j, "C")) Like "*W*" Then '字串中有"ABCD"
- On Error Resume Next
- MyFile = Dir(MyPath & "*" & Cells(j, "C") & "*.*") ' C2 = "ABCD" ->"1AABCD.png"
- If MyFile <> "" Then
- Cells(j, L).Select 'D,E欄
- With ActiveSheet.Pictures.Insert(MyPath & MyFile)
- .ShapeRange.LockAspectRatio = msoFalse
- .ShapeRange.Height = 100#
- .ShapeRange.Width = 100#
- .ShapeRange.Rotation = 0#
- .Placement = xlMoveAndSize
- .PrintObject = True
- End With
- End If
- End If
- j = j + 1
- Wend
- Range("C2").Select
- Next
- Next
- End Sub
複製代碼 |
|