1.情景展示
工作中，我们可能会遇到这种情况，需要将拍摄的照片批量插入到excel中
，出现的问题在于：
我们不仅需要将其一个一个的插入到对应的单元格中，还需要将其缩放至合适大小。
工作量很大且繁琐，有没有办法能够解决这个问题呢？
2.解决方案
实现方式：通过宏命令实现。
第一步：先插入第一张图片（一般情况下，批量导入的图片大小是一致的）；
如上图所示，将图片调整至合适大小；
第二步：按照图片将单元格调至合适大小，删除该图片；
选中要插入图片的单元格，将其大小调整至和刚才图片的大小一致。
第三步：鼠标选中要插入第一张图片的单元格；
第四步：ALT+F11-->打开VBA编辑器-->插入-->模块；
将下列代码拷贝至弹出的窗口：
Sub 批量插入图片且自适应单元格()
Dim fileNames As Variant
Dim fileName As Variant
Dim fileFilter As String
'所有图片文件后面的括号为中文括号
fileFilter = ("所有图片文件（*.jpg;*.bmp;*.png;*.gif）,*.jpg;*.bmp;*.png;*.gif")
fileNames = Application.GetOpenFilename(fileFilter, , "请选择要插入的图片", , MultiSelect:=True)
'循环次数
Dim i As Single
i = 0
'忽略错误继续执行VBA代码，避免出现错误消息（数组fileNames为空时，会报错）
On Error Resume Next
'循环插入
For Each fileName In fileNames
'将图片插入到活动的工作表中&选中该图片
With ActiveSheet.Pictures.Insert(fileName).Select
'图片自适应单元格大小
Dim picW As Single, picH As Single
Dim cellW As Single, cellH As Single
Dim rtoW As Single, rtoH As Single
'鼠标所在单元格的宽度
cellW = ActiveCell.Width
'鼠标所在单元格的高度
cellH = ActiveCell.Height
'图片宽度
picW = Selection.ShapeRange.Width
'图片高度
picH = Selection.ShapeRange.Height
'重设图片的宽和高
rtoW = cellW / picW * 0.95
rtoH = cellH / picH * 0.95
If rtoW < rtoH Then
Selection.ShapeRange.ScaleWidth rtoW, msoFalse, msoScaleFromTopLeft
Else
Selection.ShapeRange.ScaleHeight rtoH, msoFalse, msoScaleFromTopLeft
End If
picW = Selection.ShapeRange.Width
picH = Selection.ShapeRange.Height
'锁定图片锁定纵横比
Selection.ShapeRange.LockAspectRatio = msoTrue
'图片的位置与大小随单元格变化而变化
Selection.Placement = xlMoveAndSize
'设置该图片的所在位置
Selection.ShapeRange.IncrementLeft (cellW - picW) / 2 + cellW * i
Selection.ShapeRange.IncrementTop (cellH - picH) / 2
End With
i = i + 1
'下一个
Next fileName
End Sub
第五步：按F5运行；
选中你要插入的图片--》打开；
3.效果展示
4.扩展说明
4.1 代码说明
将图片设置为横向排列，代码如下：
'设置该图片的所在位置（图片横向排列）
Selection.ShapeRange.IncrementLeft (cellW - picW) / 2 + cellW * i
Selection.ShapeRange.IncrementTop (cellH - picH) / 2
将图片设置为纵向排列，代码如下：
'设置该图片的所在位置（图片纵向排列）
Selection.ShapeRange.IncrementLeft (cellW - picW) / 2
Selection.ShapeRange.IncrementTop (cellH - picH) / 2 + cellH * i
将图片插入到同一位置，代码如下：
'设置该图片的所在位置（图片位于同一位置）
Selection.ShapeRange.IncrementLeft (cellW - picW) / 2
Selection.ShapeRange.IncrementTop (cellH - picH) / 2
4.2 技巧说明
选中图片，同时按住Shift键和方向键，可以实现对图片的缩小、放大；
选中图片，同时按住Ctrl键和方向键，可以实现对图片的位置的进行微调。
