|
今日表格中有很多图片，老板要我把图片全部保存到一个文件夹下。这点小事岂能难倒我？ 于是我打开Excel表格，拉到了最后面  我勒个擦，有一千多个。没事，我还有VBA秘籍！具体情况如图所示  于是我默默打开了VBE编辑器，输入了如下代码：
Private Sub CommandButton1_Click()
'注意，如果存在重名的，那么就会把原来的给覆盖
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then
apath = .SelectedItems(1)
Else
MsgBox "请选择保存目录": Exit Sub
End If
End With
Dim shp As Shape
Dim cht As ChartObject
k = 21
For Each shp In ActiveSheet.Shapes
If shp.Type = msoPicture Then
'排除其他shape
a = shp.TopLeftCell.Address
b = shp.BottomRightCell.Address
'得到图片上下界
Set Rng = Range(a, b)
100:
k = k + 1
Cells(k, "C").Select
If Intersect(ActiveCell, Rng) Is Nothing Then GoTo 100
'只有在单元格里面才会导出
shp.Copy
Set cht = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height)
'创建新的嵌入式图表
cht.Select
'如果没有这句将会导出空白的图片文件
With cht.Chart
.Paste
.Export apath & "\" & Cells(k, 2) & ".png"
'export
.Parent.Delete
'删除添加的图表对象
End With
End If
Next
Set shp = Nothing
Set cht = Nothing
MsgBox "完毕!图片已保存到" & apath
End Sub
收工！摸鱼工资到手！
|