01.31 Excel如何根據姓名批量上傳相片，你跟高手差的只是這段代碼

今天我們來學習一下，如何在表格中，根據指定的名稱自動通過代碼添加指定的圖片到表格的指定區域當中，這個在統計相關信息的時候非常簡單和方便，不用再去確定核對名稱了。

效果圖

如上圖所示，我們在文件中有許多人的相片，現在我們需要在表格中根據姓名添加相片到對應的表格中，這裡我們就可以用代碼實現一次性上傳，而且還能進行自動對齊。

第一步：點擊開發工具—Visual Basic，插入模塊進入代碼編輯窗口，如下圖：

第二步：代碼編輯窗口添加以下代碼內容：

Sub InsertPic()

Dim Arr, i&, k&, n&, pd&

Dim PicName$, PicPath$, FdPath$, shp As Shape

Dim Rng As Range, Cll As Range, Rg As Range, book$

With Application.FileDialog(msoFileDialogFolderPicker)

.AllowMultiSelect = False

If .Show Then FdPath = .SelectedItems(1) Else: Exit Sub

End With

If Right(FdPath, 1) <> "" Then FdPath = FdPath & ""

Set Rng = Application.InputBox("請選擇圖片名稱所在的單元格區域", Type:=8)

Set Rng = Intersect(Rng.Parent.UsedRange, Rng)

If Rng Is Nothing Then MsgBox "選擇的單元格範圍不存在數據！": Exit Sub

book = InputBox("請輸入圖片偏移的位置，例如上1、下1、左1、右1", , "右1")

If Len(book) = 0 Then Exit Sub

x = Left(book, 1)

If InStr("上下左右", x) = 0 Then MsgBox "你未輸入偏移方位。": Exit Sub

y = Val(Mid(book, 2))

Select Case x

Case "上"

Set Rg = Rng.Offset(-y, 0)

Case "下"

Set Rg = Rng.Offset(y, 0)

Case "左"

Set Rg = Rng.Offset(0, -y)

Case "右"

Set Rg = Rng.Offset(0, y)

End Select

Application.ScreenUpdating = False

Rng.Parent.Select

For Each shp In ActiveSheet.Shapes

If Not Intersect(Rg, shp.TopLeftCell) Is Nothing Then shp.Delete

Next

x = Rg.Row - Rng.Row: y = Rg.Column - Rng.Column

Arr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif")

For Each Cll In Rng

PicName = Cll.Text

If Len(PicName) Then

PicPath = FdPath & PicName

pd = 0

For i = 0 To UBound(Arr)

If Len(Dir(PicPath & Arr(i))) Then

ActiveSheet.Pictures.Insert(PicPath & Arr(i)).Select

With Selection

.ShapeRange.LockAspectRatio = msoFalse

.Top = Cll.Offset(x, y).Top + 5

.Left = Cll.Offset(x, y).Left + 5

.Height = Cll.Offset(x, y).Height - 10

.Width = Cll.Offset(x, y).Width - 10

End With

pd = 1

n = n + 1

[a1].Select: Exit For

End If

Next

If pd = 0 Then k = k + 1

End If

Next

MsgBox "共處理成功" & n & "個圖片，另有" & k & "個非空單元格未找到對應的圖片。"

Application.ScreenUpdating = True

End Sub

1、 Dim Rng As Range, Cll As Range, Rg As Range, book$：定義文件夾，選擇相片所在文件夾路徑；

2、 Set Rng = Application.InputBox：定義圖片名稱，選擇需要添加圖片的名稱區域；

3、 book = InputBox("請輸入圖片偏移的位置，例如上1、下1、左1、右1", , "右1")：判斷你需要添加的圖片位置在你名稱的位置關係，偏移的值是多少；

4、 Arr = Array(".jpg", ".jpeg", ".bmp", ".png", ".gif")：創建數組，確定允許上傳的圖片格式類型。你可以根據自己的需要設置上傳圖片的格式文件。

現在你學會如何批量上傳相片到表格中了嗎？