工作表中批量插入同1文件夹下图片到单元格中并对准.docVIP

工作表中批量插入同一文件夹下图片到单元格中并对准 8楼代码已经完全改变思路，效率更高更可靠。 本楼代码可以无视，仅作学习参考用。 Sub PicBatchIn() K = InputBox(请输入插入图片换行数，默认10张, 插入图片换行数, 10) 指定插入满10张图片后换行。当然可以根据需要改成k=5或者k=20之类的。 If K = Then K = 1 如果选择ESC退出输入对话框，则把k值设定为1，即在同一列中按行插入。 Dim r As Range: Set r = ActiveCell 指定当前单元格为开始插入图片的位置。 OpenFile = Application.GetOpenFilename(Picture Files(*.jpg),*.jpg, , Get Picture from here!) 找到目标文件夹，并随便选取一张jpg图片。 如果图片格式不是*.jpg，请修改代码，如同下面： OpenFile = Application.GetOpenFilename(Picture Files(*.bmp),*.bmp, , Get Picture from here!) 找到目标文件夹，并随便选取一张bmp图片。 If OpenFile = False Then Exit Sub 如果选择为空或ESC，则结果为错误退出此vba过程。 Application.ScreenUpdating = False 暂停屏幕刷新 L = InStrRev(OpenFile, \) 查找最后一个文件夹特定字符\ myDir = Left(OpenFile, L) 抽取所选文件夹字符，如D:\Documents\ P = Dir(myDir *.jpg) 用Dir命令寻找jpg图片。（或改为bmp图片） ActiveSheet.Pictures.Insert (myDir P) 插入第一张图片 下面部分代码，是为了找到现在工作表中自动赋值的图片序号 Dim Shp As Shape For Each Shp In ActiveSheet.Shapes 遍历所有工作表中图形 ShpNm = Shp.Name 得到每个图形的名称 PicNo = Val(Mid(ShpNm, InStr(ShpNm, ), Len(ShpNm))) 查找空格并取其后的数值为图片序号。 If PicNo m Then m = PicNo 使N变量保持为较大值，直至遍历循环结束，即可找到最大值。 Next Do While P 循环直至结束。 r.Cells(1 + n \ k, n Mod k + 1).Select 选择将要插入图片的单元格，并按照指定k参数换行 即把n除以k以后的整数部分作为换行顺序值，而n对于k的余数部分作为列顺序值。 If U = 0 Then U = 1 Else ActiveSheet.Pictures.Insert (myDir P) 除第一张以外，每次插入新图片 ActiveSheet.Shapes.Range(图片 m + n).Select 选择刚才插入的图片，已有图片序号m+新插入数n。 ActiveSheet.Shapes.Range(Picture m + n).Select 在英文版中的代码图片=Picture。 以下是确定让图片顶部、左侧位置以及图片高、宽对准单元格 With Selection .Top = r.Cells(1 + N \ K, N Mod K + 1).Top .Left = r.Cells(1 + N \ K, N Mod K + 1).Left .ShapeRange.LockAspectRatio = msoFalse 设置图片格式为高宽不按比例变化。 .Height = r.Cells(1 + N \ K, N Mod K + 1).Height .Width = r.Cells(1 + N \ K, N Mod K + 1).Width .Placement = xlMoveAndSize 设置图片格式为跟随单元格大小变化。 End With n = n + 1 图片序号+1