分享 Excel 批量图片导入功能，使单元格高度和宽度适应图片。

Excel 批量图片导入功能，很多插件有这个功能，大部分插件的导入功能都是使图片适应单元格的大小，

但是这点可能跟很多人的实际需求不一样，因此我单独写了一个图片导入功能，使单元格适应图片的大小。

代码缺点，需要手工替换代码中的 .png 图片格式为你 自己需要导入的 图片文件格式.

附上代码：

Sub 导入图片()

Dim wenjian_geshu

Dim lujin

Dim tupian_name

Dim zonghe_bi

Dim hanggao

Dim tishi_kuozhangming

tishi_kuozhangming = MsgBox(vbCrLf & "请确认是否需要 修改 程序代码的 文件扩展名 ？ " & vbCrLf & vbCrLf _

& "点击 “确定” 退出程序，并修改程序扩展名；" & vbCrLf & vbCrLf _

& "点击 “取消” 继续导入图片。" & vbCrLf & vbCrLf _

, vbOKCancel)

If tishi_kuozhangming = vbOK Then Exit Sub

wenjian_geshu = 0

lujin = InputBox("请输入图片文件夹路径，可以贴入路径")

If lujin = "" Then Exit Sub

tupian_name = Dir(lujin & "*.png", vbNormal)

'.png 格式可以更改为其他格式，用于显示其他格式的图片，

'.png 可以替换为 .* 任意文件格式，但是为了避免 ActiveSheet.Shapes.AddPicture(lujin & "" & ActiveSheet.Cells(wenjian_geshu, 1).Text & ".png", _ 程序出错，暂时不替换

'但是可以新建不同的工作簿，再导入不同格式的图片后，将表格合并为一张表格。

'不可以在同一工作簿的不同表格中重复执行 代码，即使将 新建分页表 的 名称改为 Sheet1 也不可以，因为本人水平有限不会修改测试了。希望能有大神优化下代码。

Do

If tupian_name = "" Then '输出图片名称 到 第 1 列

Exit Do

End If

wenjian_geshu = wenjian_geshu + 1

ActiveSheet.Cells(wenjian_geshu, 1).Select '方便查看执行到哪一行了

ActiveSheet.Cells(wenjian_geshu, 1) = tupian_name '输出图片名称

Rows(wenjian_geshu).RowHeight = 409 '设置行高为 Excel 的最大值 409

Columns(5).ColumnWidth = 255 '设置列宽为 Excel 的最大值 255

Dim tupian

Set tupian = ActiveSheet.Pictures.Insert(lujin & "" & ActiveSheet.Cells(wenjian_geshu, 1).Text)

With tupian

.ShapeRange.LockAspectRatio = msoTrue '锁定纵横比

.Placement = xlMoveAndSize '图片大小和位置随单元格的大小和位置而改变。

.Top = ActiveSheet.Cells(wenjian_geshu, 5).Top + 4

.Left = ActiveSheet.Cells(wenjian_geshu, 5).Left + 4 '两行代码设置图片左上角位置，对其单元格，距离单元格边距为 4

zonghe_bi = .Width / .Height '取得图片的 长宽比，以便后续图片的实际高度超过行高的时候，重新设置图片宽度，以保持图片缩小后的长宽比例

Cells(wenjian_geshu, 2) = Int(.Height) + 1

hanggao = Cells(wenjian_geshu, 2) + 3

If hanggao > 409 Then '不超过 409 则就使用上一行代码图片的默认长度

.Height = 403 '超过 EXCEL 最大行高 409，则设置图片 高度为 403，并根据图片纵横比 重新设置图片的长度

.Width = zonghe_bi * .Height ' 根据图片综合比 重新设置图片的长度

Else '不超过 409 则就使用上一行代码图片的默认长度

Rows(wenjian_geshu).RowHeight = hanggao + 6

End If

Cells(wenjian_geshu, 6) = .Width '图片后面的第一列即表格的第六列存储

If wenjian_geshu > 1 Then

If Cells(wenjian_geshu, 6) < Cells(wenjian_geshu - 1, 6) Then Cells(wenjian_geshu, 6) = Cells(wenjian_geshu - 1, 6)

End If

'取得列宽最大值，以便循环结束后设置最大列宽

Cells(wenjian_geshu, 1) = Left(Cells(wenjian_geshu, 1), Len(Cells(wenjian_geshu, 1)) - 4) '重新输出图片名称，去掉扩展名。

Cells(wenjian_geshu, 7) = .Height '在执行 Delete 语句 删除 链接图片之前取得修改后的图片 宽 和 高的数据

Cells(wenjian_geshu, 8) = .Width

.Delete 'Pictures.Insert只能插入图片链接，不能将图片与表格一起保存，

'故 删除图片链接，改用 Shapes.AddPicture 导入图片，使图片与表格同时保存，以上全部代码用来设置行高和列宽，及 设置 取得 图片的 宽 和 高 ，使其适应单元格的 高 和 宽

'.png 格式可以更改为其他格式，用于显示其他格式的图片，

ActiveSheet.Shapes.AddPicture(lujin & "" & ActiveSheet.Cells(wenjian_geshu, 1).Text & ".png", _

False, _

True, _

ActiveSheet.Cells(wenjian_geshu, 5).Left + 4, _

ActiveSheet.Cells(wenjian_geshu, 5).Top + 4, _

Cells(wenjian_geshu, 8), _

Cells(wenjian_geshu, 7)).Select '在第五列导入图片

Selection.ShapeRange.LockAspectRatio = msoTrue '锁定纵横比

Selection.Placement = xlMoveAndSize '图片大小和位置随单元格的大小和位置而改变。

End With

tupian_name = Dir '再次调用 dir 执行下面的图片的循环操作，不可以有参数，

'此句为整个代码断 最重要的语句，虽然我看不懂，但是直接用吧，有用就好了，知其然而不知其所以然好了。

Loop

Columns("E:E").Select

Selection.ColumnWidth = Int(Cells(wenjian_geshu, 6) / 5.9) '设置列宽为最大图片的列宽，5.9 为图片宽度 与 Excel 表格的宽度比

Columns("A:A").Select

Columns("A:A").EntireColumn.AutoFit

Columns(6).Select

Selection.Delete Shift:=xlToLeft '设置完第 5 列的列宽后，删除存储最大列宽值的 第 6 列

Columns("F:XFD").Select

Selection.ColumnWidth = 8.11

Columns("B:D").Select

Selection.Delete Shift:=xlToLeft

Columns("C:D").Select

Selection.Delete Shift:=xlToLeft

Range("A1").Select

'可以通过删除和插入列 的代码，调整图片名称列 和 图片实际位置列 最终所在的位置列

ActiveSheet.UsedRange.Select '添加边框

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

MsgBox ("图片导入完成！")

Range("A1").Select

End Sub

程序执行完成以后，A列放置的数据为自己命名的图片名称，B列放置的为图片。

Excel 批量图片导入功能，使单元格高度和宽度适应图片

大家在制作员工信息表时会插入大量员工照片，使用常规方法插入逐个照片费时费力，其实用一行代码就可以搞定批量插入照片。以下图为例，批量导入4张照片并且对应姓名行。

准备工作：

1、把要插入的图片复制到电脑的D盘的“照片”文件夹下面

2、照片的名称要和表格内的姓名相同

步骤1、在C2单元格输入代码，敲回车。

步骤2、填充C2:C5单元格

步骤3、复制C2:C5单元格内容到记事本

步骤4、将记事本的内容再复制回C2:C5单元格(使用Ctrl+V 粘贴快捷键)，出现4张图片。

步骤5、调整图片至适当位置

批量导入图片是不是很简单。

最后解释一下这段代码，img src=文件路径，这里的文件路径是D盘的照片文件夹下，对应A2姓名的图片名称。width=60是插入后图片的宽度60，height=40是插入后图片的高度40。好了，今天就分享到这里。

需要模板的小伙伴可以私信我，回复“分享”，获取精美图表模板和财务表格资源。

在制作档案时，常常需要插入相应的照片以便管理，那你知道如何快速插入员工的照片吗？不知道的小伙伴一定要看下去哦。

第一步：将图片裁剪为相同的大小，并且将每一张图片名称命名为Excel员工中名字一样。

如图所示：

第二步：在单元格中输入以下公式

="

之前有分享过一次，在Excel表格中插入大量图片的方法，今天，再分享一种方法，只使用一个命令就能达到批量插入图片的方法。

同样以制作一个花卉表格为例：

最终完成后的表格如下图所示

1，制作一个不含图片的表格

首先是，先制作一个不含图片的表格，这次，不用做任何的排序。

2，输入命令代码

在C2单元格输入命令代码：

="

小伙伴们好啊，今天老祝继续和大家分享一个比较冷门的技巧，将照片批量导入Excel表。

首先在Excel工作表中输入员工姓名和序号。

在文件夹中准备好统一尺寸的员工照片：

单击姓名所在列的任意单元格，在【数据】选项卡下点击【升序】按钮：

然后设置工作表的行高和列宽。设置的行高可以比实际图片高度再大一些。

单击C2单元格，插入图片。

在【插入图片】对话框中找到照片文件夹位置，单击任意一个图片，然后按Ctrl+A全部选定，再按【插入】按钮：

插入的图片效果如下图所示：

选中最上层的照片，拖动到最后一个姓名的对应位置。

单击最后一个图片，再按Ctrl+A选中全部图片

单击【格式】→对齐→纵向分布

然后再单击【格式】→对齐→水平居中

此时的效果如下图所示：

单击A列序号任意单元格，数据→升序

最后再适当调整一下行高列宽，OK

公司要求把员工照片插入到员工信息表里。公司员工有300多人，如果手工插入，费时且易出错，介绍一种快速准确地插入照片方法：

关键步骤提示

1、公式输入

在C2单元格输入公式“="

1.做一个简单表格,如图这样

测试数据

2.新建一个img文件夹，命名为照片，放到d盘中，按人名命名。

img文件夹

3.然后在照片中输入此内容

="