资源介绍
批量照片自动插入不再是难题，一键全插入VBA代码如下：
Option Explicit
Sub InsertPicture()
Dim MyShape As Shape
Dim r As Integer
Dim c As Integer
Dim PicPath As String
Dim Picrng As Range
With Sheet1
For Each MyShape In .Shapes
If MyShape.Type = 13 Then
MyShape.Delete
End If
Next
For r = 7 To .Cells(.Rows.Count, 7).End(xlUp).Row Step 10
For c = 6 To 6
PicPath = ThisWorkbook.Path & "\" & .Cells(r, c).Text & ".jpg"
If Dir(PicPath) <> "" Then
Set MyShape = .Shapes.AddPicture(PicPath, False, True, 250, 250, 250, 250)
Set Picrng = .Range(Cells(r - 4, c - 4), Cells(r + 1, c - 4))
With MyShape
.LockAspectRatio = msoFalse
.Top = Picrng.Top + 1.5
.Left = Picrng.Left + 1.5
.Width = Picrng.Width - 1.5
.Height = Picrng.Height - 1.5
.TopLeftCell = ""
End With
Else
.Cells(r - 4, c - 4) = "暂无照片"
End If
Next
Next
End With
Set MyShape = Nothing
Set Picrng = Nothing
End Sub
Sub MyName()
Dim MyName As String
Dim r As Integer
r = 7
MyName = Dir(ThisWorkbook.Path & "\" & "*.jpg")
Do While MyName <> ""
If MyName <> ".jpg" And MyName <> ".." Then
Cells(r, 6) = MyName
r = r + 10
Else
Cells(r, 6).ClearContents
End If
MyName = Dir
Loop
Cells.Replace What:=".jpg", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub