VBA自学应用（4）——批量导出图片到指定文件夹

今日表格中有很多图片，老板要我把图片全部保存到一个文件夹下。这点小事岂能难倒我？
于是我打开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

收工！摸鱼工资到手！