excel的VBA插图源代码，解决2010版后插图源路径破坏图片不影响问题

最新推荐文章于 2024-07-22 14:00:47 发布

postfxj

最新推荐文章于 2024-07-22 14:00:47 发布

阅读量2.2k

点赞数

分类专栏：编程技术

本文链接：https://blog.csdn.net/postfxj/article/details/78121481

版权

编程技术专栏收录该内容

44 篇文章 1 订阅

订阅专栏

1　背境：

原来使用ActiveSheet.Pictures.Insert(temp).Select方法，对2007版本及以前没有路径也是可以的，可是到了2010版后，这个函数是存储的路径了。

2　解决方法：
Sheet1.Shapes.AddPicture　方法兼容所有版本，可以把图片准确插入指定的位置。

3　示例：按照某一列数据生成图片文件路径，然后把图片插入指定的位置。

Sub Macro1()
   Dim SrcRange As Range, SrcSheet As Worksheet
   Dim i As Integer, count As Integer, picLeft As Integer, picTop As Integer, picWidth As Integer, picHeight As Integer
  
   Set SrcSheet = ActiveWorkbook.Sheets("sheet1")
    i = Worksheets("sheet1").Range("B1").CurrentRegion.Rows.count
    For count = 2 To i

    '图片要插在哪一列
      picRange = "D" + Trim(Str(count)) + ":D" + Trim(Str(count))
       picLeft = Range(picRange).Left + 10
       picTop = Range(picRange).Top + 10
       picWidth = Range(picRange).Width - 20
       picHeight = Range(picRange).Height - 20

      '以哪一列的值做为图片名
       fileRange = Trim(Range(Cells(count, 2), Cells(count, 2)).Value)
       picPath = "P:\" + fileRange + ".jpg"
      If Dir(picPath) <> "" Then
          SrcSheet.Shapes.AddPicture picPath, True, True, picLeft, picTop, picWidth, picHeight
      End If
     Next
End Sub