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')：创建数组，确定允许上传的图片格式类型。你可以根据自己的需要设置上传图片的格式文件。

现在你学会如何批量上传相片到表格中了吗？