批量插入图片并调整大小

Metoo

刚才正好帮人写了一个

1. Private Sub tsheet4()
   
2. 
   
3.     Dim MyPcName As String
   
4.     Dim RG As Range, SP As Shape, i%
   
5. 
   
6.     For i = 2 To 5
   
7. 
   
8.         Set RG = Cells(i, 3)
   
9.         MyPcName = ActiveSheet.Cells(i, 1).Value & ".jpg"
   
10. 
    
11.             With ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\111" & MyPcName)
    
12. 
    
13.             With .ShapeRange
    
14.                 .LockAspectRatio = msoFalse
    
15.                 .Width = RG.Width
    
16.                 .Height = RG.Height
    
17.             End With
    
18.             .Placement = xlMoveAndSize
    
19.             .Top = RG.Top
    
20.             .Left = RG.Left
    
21. 
    
22.         End With
    
23.         
    
24.     Next i
    
25. 
    
26. End Sub
    

复制代码