Sub ExportChart()
    Dim myChart As Chart
    Dim myFileName As String
    Set myChart = Sheet1.ChartObjects(1).Chart
    myFileName = "myChart.jpg"
    On Error Resume Next
    Kill ThisWorkbook.Path & "/" & myFileName
    myChart.Export Filename:=ThisWorkbook.Path & "/" & myFileName, Filtername:="JPG"
    MsgBox "OK"
    Set myChart = Nothing
End Sub





转自 http://blog.csdn.net/laoyebin/article/details/5741671

Sub exportJosn()

Dim s As String

    Dim fullName As String

    Dim Data1 As String

    Dim rng As Range

    Dim xLen As Integer

    Dim yLen As Integer

    Dim r1 As Integer

    Dim c1 As Integer

    

    fullName = Replace(ActiveWorkbook.fullName, ".xlsm", ".lua")

    xLen = Range("a1").CurrentRegion.Columns.Count

    yLen = Range("a1").CurrentRegion.Rows.Count

    

    Open fullName For Output As #1

    

    Print #1, "_G.FileName= "

    Print #1, "{"

    

    For r1 = 2 To yLen

        s = ""

        For c1 = 1 To xLen

            If (Application.IsNumber(Cells(r1, c1).Value)) Or Left(Cells(r1, c1).Value, 1) = Chr(34) Then

               s = s & Cells(1, c1).Value & " = " & Cells(r1, c1).Value

            Else

                s = s & Cells(1, c1).Value & " = " & Chr(39) & Cells(r1, c1).Value & Chr(39)

            End If

            

            If c1 < xLen Then

                s = s & ", "

            End If

        Next

        If r1 < yLen Then

            Print #1, "[" & Cells(r1, 1).Value & "]" & " = {" & s & "}, "

        Else

            Print #1, "[" & Cells(r1, 1).Value & "]" & " = {" & s & "}, "

        End If

        

    Next

    

    Print #1, "}"

    

    Close #1





    MsgBox ("ok!")

    

    

End Sub

Sub csv()
    Dim Fs, myFile As Object
    Dim myfileline As String 'txtfile的行数据
    Dim sht As Worksheet
    Dim csvFileName As String 'csv文件名
    Dim totalRows As Integer ' 总的行数
    Dim totalColumns As Integer '总的列数
    Dim sheetNumber As Integer '工作表号
    Dim strAll As String '整个工作表的文本
    
    csvFileName = InputBox("请输入文件名：", "CSV", "export_csv")
    totalRows = 17 ' 总的行数
    totalColumns = 10 '总的列数
    sheetNumber = 1 '工作表号
   
    For Each sht In ThisWorkbook.Sheets
       
        Set Fs = CreateObject("Scripting.FileSystemObject")   '建立filesytemobject
        Set myFile = Fs.createtextfile(ActiveWorkbook.Path & "\" + csvFileName & "_Sheet" + CStr(sheetNumber) + ".csv") '通过filesystemobject新建一个csv文件
        
        For i = 1 To totalRows  '从第1行开始
            ra = CStr(sht.Cells(i, 1).Value)    '从第一列开始
            If ra = "" Then Exit For
            rb = ""
            For j = 1 To 10
                ca = CStr(sht.Cells(1, j).Value)
                If ca = "" Then Exit For
                If rb = "" Then
                    rb = CStr(sht.Cells(i, j).Value)
                Else
                    rb = rb & "," & CStr(sht.Cells(i, j).Value)
                End If
            Next j
            myFile.writeline (rb)
            strAll = strAll + rb + vbCrLf
            
        Next i
        Set myFile = Nothing
        Set Fs = Nothing                   '关闭文件和filesystemobject对象
         
         SaveSetting AppName:="MyApp201912", Section:="MySection", Key:="Sheet" & CStr(sheetNumber), Setting:=strAll '保存所有文本到注册表
         
         sheetNumber = sheetNumber + 1 '下一个工作表
         
    Next
    
    MsgBox ("已保存了" + CStr(sheetNumber - 1) + "个CSV文件！")
    
    MsgBox "已保存工作表内容到注册表：HKEY_CURRENT_USER\Software\VB and VBA Program Settings\MyApp201912\MySection"
End Sub


 

本次案例来自悟空问答网友提问，之前由于时间原因，回复比较简单没有给出具体实现方法，今天花时间整理写成图文，希望小伙伴们都可以学会。@沉默的生物钟
实际问题
一、数据模拟--素材准备
为了更加真实的还原提问者遇到的问题，我们需要准备600个且都包含有2个图片的Excel文件。
一两个文件我们可以手动新建就可以了，这可是600个文件呐！别担心，既然我们是用VBA来解决问题，解决这种事情重复机械的劳动，当然不是什么难事。图片我们用以下两个代替，放到当前文件目录下，分别命名为test1.png和test2.png，模拟数据时将test1.png插入到第一个表,test2.png插入到第二个工作表。
test1.png
test2.png
二、数据模拟--分步操作过程
第一步:新建一个Excel文件，将它另存为.xlsm格式。
启用宏的工作簿
第二步:打开新建好的.xlsm文件，按快捷键ALT+F11进入VBE界面。
进入VBE界面
第三步:在VBE工程中插入一个模块。
插入模块
第四步:在刚刚新建的模块中粘贴以下代码。
Sub 生成600个含图片的Excel文件()    '关闭刷新，防止屏幕抖动    Application.ScreenUpdating = False    '定义变量i    Dim i As Integer    '定义i从1循环到600    For i = 1 To 600        '新增一个工作簿        Workbooks.Add        '往工作簿的第一个工作表中插入图片test1.png        ActiveWorkbook.Sheets(1).Pictures.Insert(ThisWorkbook.Path & "est1.png").Select        '往工作簿的第二个工作表中插入图片test2.png        ActiveWorkbook.Sheets(2).Pictures.Insert(ThisWorkbook.Path & "est2.png").Select        '将工作簿存储到当前路径下        ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & i & ".xlsx"        '关闭工作簿        ActiveWorkbook.Close        '继续循环新建其他工作簿    Next    '恢复屏幕刷新    Application.ScreenUpdating = True    '处理完成给出提示    MsgBox "600个含图片的Excel文件生成完成！", vbInformation, "提示信息"End Sub
第五步:执行VBA代码，生成我们需要的600个Excel文件
执行VBA代码
三、数据模拟--连贯操作演示:
演示效果
四、图片导出--解决思路
600个案例文件已经准备好了，接下来就是导出文件中的图片:
1. 找出当前目录下的所有Excel文件。
2. 打开找到的Excel文件。
3. 找出Excel文件中的所有工作表。
4. 找出工作表中的所有图片对象。
5. 把找到的每一个图片导出到当前目录下。
如果文件不多的情况下，按上面的思路手动操作导出也是可以的，其实通过VBA来解决问题也是要先把复杂问题进行简单化，一步步进行分解问题，最终形成完整解决方案。VBA代码使用方式在上面数据准备过程中已经有详细描述了，本次我们直接来运行下代码，实现导出文件中的图片。
Sub 导出当前路径下工作簿中的图片()    Dim wk$ '定义为工作簿文件    Dim i As Integer '定义工作簿中的工作表数量    Dim ii As Integer '定义为工作表中的对象个数    '关闭刷新，防止抖动    Application.ScreenUpdating = False    '遍历第一个工作簿文件    wk = Dir(ThisWorkbook.Path & "*.xlsx")    '遍历到的文件名不等于空的情况下    Do While wk <> ""        '如果文件名称和当前的名称是不一样的。        If wk <> ThisWorkbook.Name Then            '打开遍历到的工作簿            Workbooks.Open (ThisWorkbook.Path & "" & wk)            '对打开的工作簿文件进行以下操作            With ActiveWorkbook                '循环出工作簿中的每一个工作表                For i = 1 To .Sheets.Count                    '循环出工作表中的每一个对象shape                    For ii = 1 To .Sheets(i).Shapes.Count                        '临时变量，统计shape的个数                        k = k + 1                        '复制shape对象                        .Sheets(i).Shapes(ii).Copy                        '创建一个图表对象，宽高与与对象保持一致                        With .Sheets(i).ChartObjects.Add(0, 0, .Sheets(i).Shapes(ii).Width, .Sheets(i).Shapes(ii).Height).Chart                            '把图片插入进去                            .Paste                            '通过图表对象的导出方法，把图片导出到当前目录下                            .Export ThisWorkbook.Path & "" & wk & "_" & k & ".png"                            '删除图表                            .Parent.Delete                        End With                    Next                Next                '关闭打开的工作簿                .Close False            End With        End If        '继续遍历下一个工作簿        wk = Dir    Loop    '开启屏幕刷新    Application.ScreenUpdating = True    MsgBox "600个含图片的Excel文件图片导出完成！", vbInformation, "提示信息"End Sub
五、图片导出--操作演示
演示效果