1、首先在开发工具中打开VBA编辑器
2、在单元格区域当中输入一些内容作为例子
3、在VBA编辑器中插入模块
4、在模块当中输入如下代码,然后运行Sub ShapePic() Dim shpPic As Shape Dim i, j, k As Long Dim filpat茑霁酌绡h As String Dim rng As Range' Dim picW As Single, picH As Single '图片的宽和高 Dim cellW As Single, cellH As Single '单元格的宽和高 Dim cellL As Single, cellT As Single '单元格的左边和上边位置(左上角)' Dim rtoW As Single, rtoH As Single '单元格和图片的宽和高的比例 For Each im In ActiveSheet.Shapes im.Delete Next For i = 0 To 5 For j = 2 To 7 Step 5 For k = 0 To 1 'For Each rng In Range("B" & (6 + i * 8) & ":G" & (7 + i * 8)) 'For Each rng In Range(B6) For Each rng In Cells(6 + i * 8 + k, j) If rng.MergeCells Then '判断所选单元格是否是合并单元格 cellW = rng.MergeArea.Width '是的话,cellW和cellH分别等于合并单元格的宽和高 cellH = rng.MergeArea.Height Else cellW = rng.Width '不是的话,cellW和cellH分别等于单元格的宽和高 cellH = rng.Height End If cellL = rng.Left cellT = rng.Top filpath = "E:\02" & "\" & ActiveSheet.Cells(6 + i * 8 + k, j).Text & ".jpg" If Not IsEmpty(rng) Then If Dir(filpath) <> "" Then 'Set shpPic = ActiveSheet.Shapes.AddPicture(filpath, msoFalse, msoTrue, cellL + 10, cellT + 10, cellW - 20, cellH - 20) Set shpPic = ActiveSheet.Shapes.AddPicture(filpath, msoFalse, msoTrue, cellL + 10, cellT + 10, cellW - 20, cellH - 20)' picW = shpPic.Width' picH = shpPic.Height' rtoW = cellW / picW * 0.9 '设置单元格和图片的比例。并设置最终比例为原始比例的98%;' rtoH = cellH / picH * 0.9 '这样的目的在于不要让图片充满整个单元格,以便可以让人看到单元格的边线。 shpPic.LockAspectRatio = msoFalse' If rtoW < rtoH Then' shpPic.ScaleHeight rtoW, msoTrue, msoScaleFromTopLeft' 'shpPic.ScaleWidth rtoW, msoTrue, msoScaleFromTopLeft' Else' shpPic.ScaleHeight rtoH, msoTrue, msoScaleFromTopLeft' 'shpPic.ScaleWidth rtoH, msoTrue, msoScaleFromTopLeft' End If End If End If Next Next Next Next ActiveSheet.Cells(1, 2).Select' picW = shpPic.Width '根据上面确认的比例,为图片的宽和高重新赋值' picH = shpPic.Height' shpPic
5、输入完成之后我们点击保存就可以看到,我们直接插入了图片到文档当中,而不仅赞迢鹣嘞仅是一个链接了,即便我们移动文档或者移动图片,都不影响我们文档当中所插入的照片,