【VBA或JS代码】EXCEL/WPS 根据姓名批量插入图片到指定单元格并自动匹配单元格

kingkiller

现在有一个需求，需要根据姓名批量插入图片到指定单元格并自动匹配单元格大小
要求支持中文路径、图片格式支持png、jpg、jpeg

zjg121

https://wwi.lanzoup.com/iqlZV1wpn55c

[Plain Text] 纯文本查看 复制代码

?

01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59

Sub InsertPicturesByNameAndResizeCell()     Dim ws As Worksheet     Dim rng As Range     Dim cell As Range     Dim picturePath As String     Dim targetCell As Range     Dim picture As picture     Dim pictureWidth As Double     Dim pictureHeight As Double             ' 设置工作表     Set ws = ThisWorkbook.Sheets("Sheet1")             ' 假设姓名在A列，图片路径在B列     Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)             ' 遍历范围中的每个单元格     For Each cell In rng         picturePath = cell.Offset(0, 1).Value ' 获取图片路径                     ' 设置目标单元格（这里假设图片插入到C列的对应行）         Set targetCell = ws.Cells(cell.Row, "C")                     ' 插入图片         Set picture = ws.Pictures.Insert(picturePath)                     ' 将图片移动到目标单元格的位置         With picture             .Top = targetCell.Top             .Left = targetCell.Left         End With                     ' 获取图片的尺寸（不包括边框）         pictureWidth = picture.Width         pictureHeight = picture.Height                     ' 调整目标单元格的大小以匹配图片尺寸         ' 注意：这里我们尝试调整单元格大小，但可能不会完全精确                   targetCell.RowHeight = pictureHeight  '/ ws.Parent.ScreenUpdatingPixelsPerUnit * 1.3 ' 乘以一个系数以考虑行高的额外空间         targetCell.ColumnWidth = pictureWidth / 6.25 ' / ws.Parent.ScreenUpdatingPixelsPerUnit                     ' 自动调整列宽以适应内容（如果需要更精确匹配）         'targetCell.EntireColumn.AutoFit         'targetCell.EntireRow.AutoFit                     ' 隐藏图片背后的单元格网格线（可选）         targetCell.Borders(xlEdgeBottom).LineStyle = xlLineStyleNone         targetCell.Borders(xlEdgeTop).LineStyle = xlLineStyleNone         targetCell.Borders(xlEdgeRight).LineStyle = xlLineStyleNone         targetCell.Borders(xlEdgeLeft).LineStyle = xlLineStyleNone                     ' 确保图片位于单元格内并且随单元格大小变化         With picture             .Placement = xlMoveAndSize             .ShapeRange.LockAspectRatio = msoFalse ' 如果需要的话，可以解锁纵横比         End With     Next cell End Sub

aspire168

描述详细一点，vb给你写一个。

kingkiller

aspire168 发表于 2024-4-27 16:06
描述详细一点，vb给你写一个。

比如一个表格有两列，分别是社区走访人员姓名和图片两列，我现在要根据表格里的姓名来匹配自定义选择的文件夹里的所有图片，进行遍历匹配后插入对应的图片单元格中，并自动嵌入单元格中，类似WPS自带的嵌入单元格效果