Excel如何根据姓名批量上传相片,你跟高手差的只是这段代码
今天我们来学习一下,如何在表格中,根据指定的名称自动通过代码添加指定的图片到表格的指定区域当中,这个在统计相关信息的时候非常简单和方便,不用再去确定核对名称了。"Application.ScreenUpdating = TrueEnd Sub三、代码基本介绍1、 Dim Rng As Range, Cll As Range, Rg As Range, book$:定义文件夹,选择相片所在文件夹路径
今天我们来学习一下,如何在表格中,根据指定的名称自动通过代码添加指定的图片到表格的指定区域当中,这个在统计相关信息的时候非常简单和方便,不用再去确定核对名称了。"Application.ScreenUpdating = TrueEnd Sub三、代码基本介绍1、 Dim Rng As Range, Cll As Range, Rg As Range, book$:定义文件夹,选择相片所在文件夹路径;2、 Set Rng = Application.InputBox:定义图片名称,选择需要添加图片的名称区域;3、 book = InputBox:判断你需要添加的图片位置在你名称的位置关系,偏移的值是多少;4、 Arr = Array:创建数组,确定允许上传的图片格式类型。你可以根据自己的需要设置上传图片的格式文件。
今天我们来学习一下,如何在表格中,根据指定的名称自动通过代码添加指定的图片到表格的指定区域当中,这个在统计相关信息的时候非常简单和方便,不用再去确定核对名称了。 效果图 如上图所示,我们在文件中有许多人的相片,现在我们需要在表格中根据姓名添加相片到对应的表格中,这里我们就可以用代码实现一次性上传,而且还能进行自动对齐。 第一步:点击开发工具—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"):创建数组,确定允许上传的图片格式类型。你可以根据自己的需要设置上传图片的格式文件。 现在你学会如何批量上传相片到表格中了吗?一、案例演示
二、操作方法
三、代码基本介绍