请问怎么 才能在EXCEL中把图片批量并且居中的放在单元格中

就是把D：\ABCD 目录内所有的图片，平均放在这ABCD四列，3行以下，并且单元格内居中排例，每个格内一张图片，从左到右，从上到下，一直排到目录内没有图片为止,图片就按着图片编号一直排下去就可以了

可以通过VBA实现，点击【开发工具】，【Visual Basic】打开VBA编辑器，也可以使用【Alt+F11】组合键打开VBA编辑器。双击“模块1”，复制以下代码。然后插入按钮，指定宏即可。

代码如下

Sub InsertPic()

'ExcelHome VBA编程学习与实践 by:看见星光

Dim Arr, i&, k&, n&, pd&

Dim strPicName$, strPicPath$, strFdPath$, shp As Shape

Dim Rng As Range, Cll As Range, Rg As Range, strWhere As String

'On Error Resume Next

'用户选择图片所在的文件夹

With Application.FileDialog(msoFileDialogFolderPicker)

If .Show Then strFdPath = .SelectedItems(1) Else: Exit Sub

End With

If Right(strFdPath, 1) <> "\" Then strFdPath = strFdPath & "\"

Set Rng = Application.InputBox("请选择图片名称所在的单元格区域", Type:=8)

'用户选择需要插入图片的名称所在单元格范围

Set Rng = Intersect(Rng.Parent.UsedRange, Rng)

'intersect语句避免用户选择整列单元格，造成无谓运算的情况

If Rng Is Nothing Then MsgBox "选择的单元格范围不存在数据！": Exit Sub

strWhere = InputBox("请输入图片偏移的位置，例如上1、下1、左1、右1", , "右1")

'用户输入图片相对单元格的偏移位置。

If Len(strWhere) = 0 Then Exit Sub

x = Left(strWhere, 1)

'偏移的方向

If InStr("上下左右", x) = 0 Then MsgBox "你未输入偏移方位。": Exit Sub

y = Val(Mid(strWhere, 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

'遍历选择区域的每一个单元格

strPicName = Cll.Text

'图片名称

If Len(strPicName) Then

'如果单元格存在值

strPicPath = strFdPath & strPicName

'图片路径

pd = 0

'pd变量标记是否找到相关图片

For i = 0 To UBound(Arr)

'由于不确定用户的图片格式，因此遍历图片格式

If Len(Dir(strPicPath & Arr(i))) Then

'如果存在相关文件

Set shp = ActiveSheet.Shapes.AddPicture( _

strPicPath & Arr(i), False, True, _

Cll.Offset(x, y).Left + 5, _

Cll.Offset(x, y).Top + 5, _

20, 20)

shp.Select

With Selection

.ShapeRange.LockAspectRatio = msoFalse

'撤销锁定图片纵横比

.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

Application.ScreenUpdating = True

MsgBox "共处理成功" & n & "个图片，另有" & k & "个非空单元格未找到对应的图片。"

End Sub

小提示：

1，该段小代码支持一下图片格式：

".jpg", ".jpeg", ".bmp", ".png", ".gif"

2，图片的纵横比是未锁定的，如需锁定，可以注释掉下句代码：

.ShapeRange.LockAspectRatio = msoFalse