- 帖子
- 552
- 主題
- 3
- 精華
- 0
- 積分
- 578
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office 2010
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2015-2-8
- 最後登錄
- 2024-2-26
  
|
回復 2# apple99152
以下程式碼是對岸的一位老師的教學範例，我修改了一下來符合你的要求，試試- Public Sub 照片1()
- For Each shap In Sheets("照片1").Shapes
- If shap.Type <> 8 Then shap.Delete
- Next
- For Each Rng In Sheets("照片1").Range("C2", Range("c2").End(xlDown))
- Pat = "D:\TEST\" & Rng
- Set rngs = Cells(Rng.Row, "C")
- Sheets("照片1").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
- Next
- For Each Rng In Sheets("照片1").Range("E2", Range("E2").End(xlDown))
- Pat = "D:\TEST\" & Rng
- Set rngs = Cells(Rng.Row, "E")
- Sheets("照片1").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
- Next
- End Sub
- Public Sub 照片2()
- For Each shap In Sheets("照片2").Shapes
- If shap.Type <> 8 Then shap.Delete
- Next
- For Each Rng In Sheets("照片2").Range("B2", Range("B2").End(xlToRight))
- Pat = "D:\TEST\" & Rng
- Set rngs = Cells(2, Rng.Column)
- Sheets("照片2").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
- Next
- For Each Rng In Sheets("照片2").Range("B5", Range("B5").End(xlToRight))
- Pat = "D:\TEST\" & Rng
- Set rngs = Cells(5, Rng.Column)
- Sheets("照片2").Shapes.AddPicture Pat, True, True, rngs.Left, rngs.Top, Rng.Width, rngs.Height
- Next
- End Sub
|
|
發表於 2015-5-1 06:28
| 