Excel里用VBA代码插入图片不随文件保存的问题

xixidong

1. Sub 批量插入图片()
   
2. Dim wj As String
   
3. Dim rng As Range
   
4. Dim x As String
   
5. 
   
6. Sheets("Sheet1").Select '选中要插入图片的工作表
   
7. x = 1000  '最后一行的行号
   
8. For i = 1 To x
   
9. na = Cells(i, 2) '从第二列（即B列）得到员工名字，并以此名查找图片
   
10. wj = "C:\Users\Administrator\Desktop\图片" & "" & na & ".jpg" '图片文件存储的路径与格式（.jpg）
    
11. If Dir(wj) <> "" Then
    
12. With Cells(i, 6)
    
13.      PicL = .Left + .Width * 0.05
    
14.      PicT = .Top + .Height * 0.05
    
15.      PicW = .Width * 0.9
    
16.      PicH = .Height * 0.9
    
17. End With
    
18.          
    
19. With ActiveSheet.Shapes.AddPicture(wj, True, True, 0, 0, -1, -1)
    
20. End With
    
21.                
    
22. Set shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
    
23.     rh = PicH / shp.Height
    
24.     rw = PicW / shp.Width
    
25.     r = IIf(rw > rh, rh, rw)
    
26.     shp.Left = PicL
    
27.     shp.Top = PicT
    
28.     shp.ScaleWidth r, msoFalse, msoScaleFromTopLeft
    
29.    
    
30. 
    
31. End If
    
32. Next
    
33. MsgBox "图片插入完毕"
    
34. End Sub
    

复制代码