Excel技巧，批量导入导出图片VBA

最新推荐文章于 2025-05-07 13:10:55 发布

原创最新推荐文章于 2025-05-07 13:10:55 发布 · 2.5k 阅读

7 ·

CC 4.0 BY-SA版权

文章标签：

#数据库

本文介绍了一个使用VBA编写的宏，该宏能够处理Excel工作表中的图片，包括调整图片尺寸以匹配单元格大小，并将这些图片转换为图表形式再导出为JPG格式。此外，还提供了一个用于清除现有图片并根据指定路径添加新图片的宏。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Sub save_pic()

For Each p In ActiveSheet.Shapes
        ph = p.Height
        pw = p.Width
        p.ScaleHeight 1, True
        p.ScaleWidth 1, True
        
        pn = p.TopLeftCell.Offset(0, -1).Value
        Debug.Print pn, ph, pw, p.Name
        p.Name = pn
        
        p.CopyPicture
        With ActiveSheet.ChartObjects.Add(0, 0, p.Width + 5, p.Height + 5).Chart
            .Paste
            .Export "D:\ex\" & p.Name & ".jpg", "JPG"
            .Parent.Delete
        End With
        p.Width = pw
        p.Height = ph
        
        Exit For
Next


End Sub

Sub addpic()
For Each Shp In ActiveSheet.Shapes
　　    If Shp.Type = msoPicture Then Shp.Delete
　　Next

  i = 2
  Do While Range("A" & i) <> ""
  Range("B" & i).Select
  Set mypic = ActiveSheet.Pictures.Insert("D:\www\pendant\" & Range("A" & i) & ".jpg")
  With mypic
  .ShapeRange.LockAspectRatio = msoFalse
  .Top = Range("B" & i).Top + 5
  .Left = Range("B" & i).Left + 5
  .Height = Range("B" & i).Height - 10
  
  .Width = Range("B" & i).Width - 10
  
  .Placement = xlMoveAndSize
  End With
  i = i + 1
  Loop
  Set mypic = Nothing
  End Sub