|
功能：1，自动根据关键字填充照片；2，自动调整图片大小到合并单元格（有贴边拉伸填充和保持长宽比不变形填充两种可选）3，支持根据同一关键字填充多张不同位置 且不同填充单元格的照片插入。先看效果 说明1：这次的操作需要用到VBA，但是别担心，所有代码我都会在文档中贴出开，直接复制粘贴即可启用，且每个代码过程都加了注释，方便你知道从哪里更改参数以适应你的表格；2：如果你有操作不通的或者我没说明白的过程，请留言，我会第一时间给解答；3：如果你对VBA是拒绝的，我怎么会想不到，文尾我列出了另一种不用代码的纯公式批量插入图片的方法，你可以研究下 第一步：创建信息表单。这次主要用到的公式还是万能的vlookup,不熟悉的可以看下图回顾下啦，文字部分都是利用vlookup函数联立的，看不懂的可以翻翻我前面分享的文章https://www.toutiao.com/i6489852874195993102/ 第二步，建立VBA调用图片过程，需要打开电脑开发者选项，如果你的EXCEL中没有这个选项，请参考下图打开 建立函数的过程比较简单，直接复制粘贴就行了,这个调用过程实现的方式有很多，我看到的版本都不下五个，但针对本次案例的需求而言吗，下面这段代码还是比较精简合适的 请在模块中粘贴一下代码 Sub 调用图片() '以下是填充照片的过程代码 a = Range('g3').Value Range('g3').Select ActiveSheet.Pictures.Insert(ActiveWorkbook.Path & '\照片\' & a & '.jpg').Select '将以单元格B3为名字的图片按照设定的路径调用出来 With Selection ah = Range(Range('g3').MergeArea.Address).Height '赋值(合并)单元高度 aw = Range(Range('g3').MergeArea.Address).Width '赋值(合并)单元宽度 ay = Range('g3').MergeArea.Top '赋值图片高度 ax = Range('g3').MergeArea.Left '赋值图片宽度 .ShapeRange.LockAspectRatio = msoFalse .Placement = xlMoveAndSize .Height = ah - 2 '设置图片高度 .Width = aw - 2 '设置图片宽度 .Top = ay + 1 '设置图片纵向起点（即图片左上角的纵向位置） .Left = ax + 1 '设置图片横向起点（即图片左上角的横向位置） End With ActiveCell.Select '获得焦点 End Sub Sub 删除图片() '以下是删除照片的过程代码 For Each im In ActiveSheet.Pictures im.Delete Next End Sub ------------------------------------------------------------------------------------------ 请在制表sheet中粘贴以下代码 Option Explicit '强制进行变量声明 Private Sub Worksheet_change(ByVal Target As Range) On Error Resume Next '如果有错误，忽略掉，继续执行VBA代码,避免出现错误警告 Application.ScreenUpdating = False '屏幕刷新关闭 If Not Application.Intersect(Target, Range('B3')) Is Nothing Then Call 删除图片 Range('G3') = Target.Value '将目标位置的值赋予给G3(照片)所在的合并单元格 Call 调用图片 End If Range(Target.Address).Select Application.ScreenUpdating = True '屏幕刷新打开 On Error GoTo 0 '恢复错误提示 End Sub 第三步，根据需要，增加需要填充的图片及位置，对应参数的更改只需要参照下面示意在原来的代码上复制粘贴就好 第四部，调整图片填充模式，上述代码默认的是拉伸填充形式，就是不管照片比例如何，将照片强制拉伸至与单元格四个边对齐，这会照成人像变形，为了尊重以人为本的理念，请参照下示例替换如下代码： ah = Range(Range('g3').MergeArea.Address).Height '(合并)单元高度 aw = Range(Range('g3').MergeArea.Address).Width '(合并)单元宽度 ay = .Height '图片高度 ax = .Width '图片宽度 .ShapeRange.LockAspectRatio = msoTrue .Placement = xlMoveAndSize sc = Application.WorksheetFunction.Min(ah / ay, aw / ax) '单元与图片之间长宽差异比例的最小值 .Height = ay * sc - 2 '按比例调整图片宽度 .Width = ax * sc - 2 '按比例调整图片高度 .Top = Range('g3').MergeArea.Top + (Range('g3').MergeArea.Height - .Height) / 2 + 0.5 '垂直居中: .Left = Range('g3').MergeArea.Left + (Range('g3').MergeArea.Width - .Width) / 2 + 0.5 '水平居中: 注意：1.保存带有VBA宏代码的excel，需要以.xlsm格式保存，2.excel表需要与存放图片的文件夹在同一位置（注意是表格与文件夹在同一位置，不是与图片在同一位置），不然图片无法调取；复制代码请在电脑端查看，不然会遇到换行出错 下面列出一种不需要代码批量插入图片的技巧，过程比较详细，我就不多啰嗦了，至于联立信息卡里边的调用图片，我想放在下次一起分享。代码供上： |
|
|
