- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2014-2-25 15:12
| 只看該作者
回復 5# h99949 - Option Explicit
- Sub ChangeSize()
- Dim Mypath As String, E As Range, i As Integer ', MyPic As Object
- Mypath = "D:\catalogue\"
- With Sheets("工作表1")
- .Pictures.Delete
- For i = 1 To 7 Step 3 'A欄 ->1,D欄 ->4,G欄 ->7
- For Each E In .UsedRange.Columns(i).Cells ' 'A欄 ->1,D欄 ->4,G欄 ->7
-
- E.ColumnWidth = 25 '調整儲存格寬度
- E.RowHeight = 50 '調整儲存格高度
-
- If Dir(Mypath & E & ".jpg") <> "" Then
- 'Set MyPic = ActiveSheet.Pictures.Insert(Mypath & E & ".jpg")
- With .Pictures.Insert(Mypath & E & ".jpg")
- .ShapeRange.LockAspectRatio = msoFalse
- .Left = E.Cells(1, 2).Left
- .Top = E.Cells(1, 2).Top
- .Width = E.Cells(1, 2).Width '=儲存格寬度
- .Height = E.Cells(1, 2).Height '=儲存格高度
- End With
- End If
- Next
- Next
- End With
- End Sub
複製代碼 |
|