本文是教大家如何导出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
#artContent h1{font-size:16px;font-weight: 400;}