2021-03-11

excel学习笔记

如何批量导出表格里的照片和对应的图片名

Sub Rename()  
  Application.ScreenUpdating = False  
    On Error Resume Next 
       MkDir ThisWorkbook.Path & "\图片"  
         For Each pic In ActiveSheet.Shapes    
             If pic.Type = msoPicture Then    
                     RN = pic.TopLeftCell.Offset(0, -1).Value              '重命名图片         
                      pic.Copy           
                      With ActiveSheet.ChartObjects.Add(0, 0, pic.Width, pic.Height).Chart    '创建图片              
	                      .Parent.Select       
	                       .Paste          
	                       .Export ThisWorkbook.Path & "\图片\" & RN & ".jpg"        
	                       .Parent.Delete           
                       End With        
	       End If    
            Next  
 	    MsgBox "导出图片完成！" 
 	    Application.ScreenUpdating = True
 End Sub

结果：