Question

怎么在Excel表格中插入图片并在图片下方自动显示图片名称

在Excel表格中插入图片并在图片下方自动显示图片名称，这个怎么做？

Answer 1

你的问题可以用vba实现，若是处理的量很少可以直接按我说的思路自己操作。

自己操作：1）先调整要插入图片的单元格大小，并在单元格中输入插入图片的名称，并让它居中居下对齐。2）插入图片。

vba操作：通过编码先调整单元格大小后调入图片并填写文字。效果如下：

Answer 2

用宏代码实现

Sub在当前列插图() '在一列中从当前所选单元格开始依次向下方单元格插图
Lj = InputBox("请输入JPG格式图片文件所在文件夹的路径：", , ThisWorkbook.Path) '获取路径,默认为当前文件夹路径
Cc = InputBox("请设置图片长度，单位厘米：", , 7.41)

Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Setf = fs.GetFolder(Lj)
Set fc = f.Files
x = Selection.Cells(1).Row
y = Selection.Cells(1).Column
A = x
B = y
Cells.Select
Selection.VerticalAlignment = xlCenter

For Each f1 In fc
If Format(Right(f1.Name, 3),">") = "JPG" Then

Cells(x, y).Select
ActiveSheet.Pictures.Insert(Lj & "\" &f1.Name).Select '插入图片
For Each IShape In Selection.ShapeRange
Call Adjust_Picture(IShape,Cc) '调整图片大小,相应调整单元格
Next IShape

Cells(x+1, y).Select
Cells(x+1, y).Value =Left(f1.Name, Len(f1.Name) - 4) '填写文件名
With Selection
.HorizontalAlignment =xlGeneral
.VerticalAlignment =xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With

x = x + 2
End If
Next
Cells(a, B).Select
End Sub

Sub Adjust_Picture(IShape As Shape, Cc As Single) '调整图片大小,相应调整单元格
IShape.LockAspectRatio = msoTrue '锁定长宽比
IShape.Placement = xlMove '图片大小不随单元格大小变化
Range(IShape.TopLeftCell.Address).Select '选取图片左上角所在单元格
If IShape.Width > IShape.Height Then '横向图片
IShape.Width = 28.3437 * Cc '设置图片大小-宽
IShape.Top = Selection.Top + 2 '设置图片位置-顶边距
IShape.Left = Selection.Left + 2 '设置图片位置-左边距
Else '纵向图片
IShape.Height = 28.3437 * Cc * 3 / 4 '设置图片大小
IShape.Top = Selection.Top + 2 '设置图片位置-顶边距
IShape.Left = Selection.Left + (28.3437 * Cc - IShape.Width) / 2 + 2
End If
Selection.ColumnWidth = 4.715 * Cc + 0.1 '设置单元格宽
Selection.RowHeight = 28.3437 * Cc * 3 / 4 + 4.5 '设置单元格高
End Sub