Question

【求助】将有规律的图片依次放入excel工作薄，并修改图片大小，用VBA自动实现~

打开E301文件夹，在文件夹中有10个命名有规律（文件名为0433101.jpg、0433102.jpg、……、0433110.jpg）的图片文件，要求依次将这些图片放入Excel工作簿E301.xls的sheet1工作表A1，A2，…，A10单元格，并调整图片的高度和宽度分别为2.8厘米和2.2厘米。请用VBA程序自动实现

Answer 1

'将下代码放入E301.xls模块中
Sub InsertPicture()
Dim MyShape As Shape
Dim r As Integer
Dim PicPath As String
With Sheet1
For Each MyShape In .Shapes
If MyShape.Type = 13 Then
MyShape.Delete
End If
Next
Rows("1:10").Select
Selection.RowHeight = 60
Columns("A:A").Select
Selection.ColumnWidth = 8
For r = 1 To 10
Text = "0" & 433100 + r
PicPath = ThisWorkbook.Path & "\" & Text & ".jpg"
If Dir(PicPath) <> "" Then
Set MyShape = .Shapes.AddPicture(PicPath, False, True, 6, 6, 6, 6)
Set Picrng = .Cells(r, 1)
With MyShape
.LockAspectRatio = msoFalse
.Top = Picrng.Top + 1
.Left = Picrng.Left + 1
.Width = Picrng.Width + 1
.Height = Picrng.Height + 1
.TopLeftCell = ""
End With
End If
Next
End With
Set MyShape = Nothing
Set Picrng = Nothing
End Sub