本文是教大家如何导出Excel里的图片和一些小操作,冻结屏幕刷新、状态栏动态显示程序进度以及如何创建文件夹等。废话不说,上代码。 Sub 导出() Application.ScreenUpdating = False Dim strPath$, i&, ad$, sh, cht On Error Resume Next MkDir ThisWorkbook.Path & '\pic\' strPath = ThisWorkbook.Path & '\' For Each pic In ActiveSheet.Shapes js = js + 1 If pic.Name <> '按钮' Then ad = pic.TopLeftCell.Address pic.Select pic.CopyPicture Set cht = ActiveSheet.ChartObjects.Add(0, 0, 50, 50) With cht .Chart.ChartArea.Select .Chart.Paste .Chart.Shapes(1).Height = 50 .Chart.Shapes(1).Width = 50 .Chart.Export (strPath & 'pic\' & Range(ad).Offset(0, -1).Value & '.jpg') .Delete End With End If DoEvents Application.StatusBar = '正在处理' & Format(js / ActiveSheet.Shapes.Count, '0.00%') Next MsgBox 'ok!' Application.StatusBar = '' Application.ScreenUpdating = True End Sub
|
|
来自: 满泉ca85upjdlw > 《Excel知识》