Question

关于一个Excel批量插入图片的问题

这是在百度上搜到的一个在excel批量插图宏代码，可以实现批量插图，
但有3个问题：

1. 插入图片的excel表格换台电脑查看，图片无法显示。估计是批量加载了图片链接地址，非得连同图片所在文件夹一起才能显示图片。

2. Application.InputBox 句柄是要求健盘输入图片所在单元格区域，挺麻烦，不知有没有拖动鼠标选择单元格的模式，或者在这里指定单元格区域，如“A2：A500”。

3. k.Offset(0, 4).Select 是表示在目标第四列插入图片，如果我要在第四列和第五列插入不同编号（01.jpg和02.jpg）的图片，那要怎样实现？

============================================================
Sub 插入图片()
'
' 插入图片 宏
On Error Resume Next '设置错误处理
Application.ScreenUpdating = False '关闭屏幕刷新
Dim rngTemp As Range, k As Range, picPath$, picTemp As Picture
'设定图片名称所在单元格区域
Set rngTemp = Application.InputBox("选择图片名称所在单元格区域：", "选择单元格", Type:=8)
For Each k In rngTemp '循环插入图片
k.Offset(0, 4).Select '选择插入图片的位置
ActiveSheet.Pictures(k & k.Row).Delete '删除单元格中原来的图片
picPath = ThisWorkbook.Path & "\PHOTO\" & Trim(k) & "\01" & ".jpg" '定义插入图片的地址
Set picTemp = ActiveSheet.Pictures.Insert(picPath) '插入图片
picTemp.Name = k & k.Row '设定所插入图片的名称
picTemp.Placement = xlMoveAndSize '设置图片可以随单元格的变动而改变大小和位置
With picTemp.ShapeRange
.LockAspectRatio = msoFalse '取消图片纵横比锁定
.Height = Selection.Height '设置所插入图片的高度与单元格的高度相等
.Width = Selection.Width '设置所插入图片的宽度与单元格的宽度相等

End With
Set picTemp = Nothing '重置图片对象
Next
Application.ScreenUpdating = True '打开屏幕刷新
End Sub
=================================================================
请高人指点！！谢谢
楼下这个朋友，我试了贴Excel里使用，貌似没反应，不知道哪里出错了？

Answer 1

我用的是这个插入代码。我这个没有出现你的那种情况！！！
Sub pictopz()
Dim cell As Range, fd, t, w As Byte, h As Byte
Selection.ClearComments
If Selection(1) = "" Then MsgBox " ", 64, "提示": Exit Sub
On Error GoTo err
Set fd = Application.FileDialog(msoFileDialogFolderPicker) '允许用户选择一个文件夹
If fd.Show = -1 Then
t = fd.SelectedItems(1) '选择之后就记录这个文件夹名称
Else
Exit Sub '否则就退出程序
End If
w = Application.InputBox("您希望插入的图片显示多宽？" & Chr(10) & "Excel默认宽度为3.39，你可以输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认宽度", 3.39, , , , , 2)
h = Application.InputBox("您希望插入的图片显示多高？" & Chr(10) & "Excel默认高度为2.09，你可以输入1-15之间的数据。" & Chr(10) & "小于1时当做1计算。", "确认高度", 2.09, , , , , 2)
If w < 1 Or h < 1 Then w = 3.39: h = 2.09
If w > 15 Or h > 15 Then MsgBox "原则上你的图片可以显示这么大，" & Chr(10) & "不过有必要吗？请重新输入1-15之间的数", 64, "提示": Exit Sub
For Each cell In Selection
With cell.AddComment
.Visible = True
.Text Text:=""
.Shape.Select True
With Selection.ShapeRange
.Fill.UserPicture t & "\" & cell.Text & ".jpg"
.ScaleWidth w / 3.39, msoFalse, msoScaleFromTopLeft
.ScaleHeight h / 2.09, msoFalse, msoScaleFromTopLeft
End With
cell.Offset(1, 0).Select
.Visible = False
End With
Next
Exit Sub
err:
ActiveCell.ClearComments
MsgBox "未找到同名的JPG图片！", 64, "提示"
End Sub

追问

不行， 不知道 原因，请赐教 ！
zjr.b＃163.com

追答

先在表格中增加图片文件名的列，然后alt+F11，打开表格插入宏，将上面的文本粘贴进去，关闭即可。选中表格增加的那列，alt+F8，有个宏的名称，按照提示找到你图片所在的文件夹。确定--调整图片大小即可点出。这个是以“批注”的形式显示的，所以不会消失的。

追问

我就是这样做的。。。
执行宏，弹出一个窗体，感叹号的，没有任何信息，无法进行下一步操作。。

追答

先在表格中增加图片文件名的列，然后alt+F11，“插入----模块”，

将上面的文本粘贴进去，关闭即可。选中表格增加的那列，alt+F8，执行有个宏的名称，按照提示找到你图片所在的文件夹。确定--调整图片大小即可点出。这个是以“批注”的形式显示的，所以不会消失的。

记住不要选择标题！！！！要选择图片文件名字的那个作为开始。

追问

非常感谢这位热心的网友，基本可以用了，但同样有几个问题：
1. 图片大小尺寸能否更精准调整。如确定宽度，高度随比确定。
2. 在代码里修改的图片尺寸最终显示似乎不是一回事，如，我设置了宽都一样，道理应该显示正方形，但事实不是。当然，图片是正方型的。
2. 批注显示位置能不能控制？
3. 如果遇到找不到图片的编号就终止程序了。余下的批注不再自动生成。
4.宽与高的文字标识似乎反了。