精华内容
下载资源
问答
  • VBA导出Excel里的图表为JPG文件

    千次阅读 2015-05-26 16:01:06
    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.Pat
    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 Int
    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的行数据 ...") MsgBox "已保存工作表内容到注册表:HKEY_CURRENT_USER\Software\VB and VBA Program Settings\MyApp201912\MySection" 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个文件呐!别担心,既然我们是...

    本次案例来自悟空问答网友提问,之前由于时间原因,回复比较简单没有给出具体实现方法,今天花时间整理写成图文,希望小伙伴们都可以学会。@沉默的生物钟

    e065a045187518d1b31e7ac74dc1b7c1.png

    实际问题

    一、数据模拟--素材准备

    为了更加真实的还原提问者遇到的问题,我们需要准备600个且都包含有2个图片的Excel文件。

    ed4934287100cf204046bf7ca8c2469c.png

    一两个文件我们可以手动新建就可以了,这可是600个文件呐!别担心,既然我们是用VBA来解决问题,解决这种事情重复机械的劳动,当然不是什么难事。图片我们用以下两个代替,放到当前文件目录下,分别命名为test1.png和test2.png,模拟数据时将test1.png插入到第一个表,test2.png插入到第二个工作表。

    a6ad642cbd25c6c7c92c0fee2808311b.png

    test1.png

    f1399f371935c1a21cd05b2bdf02c982.png

    test2.png


    二、数据模拟--分步操作过程

    第一步:新建一个Excel文件,将它另存为.xlsm格式。

    72896be20084097d49baa1bb96a486c6.png

    启用宏的工作簿

    第二步:打开新建好的.xlsm文件,按快捷键ALT+F11进入VBE界面。

    4880ae78b73d12aca78abacb3c03818b.png

    进入VBE界面

    第三步:在VBE工程中插入一个模块。

    de506bdea4349c82999ef843c7ddb24e.png

    插入模块

    第四步:在刚刚新建的模块中粘贴以下代码。

    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文件

    49f414039ace4c4cf0f14a9c0c7ab7a9.png

    执行VBA代码


    三、数据模拟--连贯操作演示:

    dbacd52d404058a0bfb861c80c1f95ae.gif

    演示效果

    四、图片导出--解决思路

    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

    五、图片导出--操作演示

    537ea1373a50a95d7d74bf3bdc6d371b.gif

    演示效果

    展开全文
  • @沉默的生物钟实际问题一、数据模拟--素材准备为了更加真实的还原提问者遇到的问题,我们需要准备600个且都包含有2个图片的Excel文件。一两个文件我们可以手动新建就可以了,这可是600个文件呐!别担心,既然我们是...
  • @沉默的生物钟实际问题一、数据模拟--素材准备为了更加真实的还原提问者遇到的问题,我们需要准备600个且都包含有2个图片的Excel文件。一两个文件我们可以手动新建就可以了,这可是600个文件呐!别担心,既然我们是...
  • 下面是利用VBA导出文件的例子,可以导出Excel内容等其他可以使用VBA的地方。 Sub export_file() Dim fs, ft As Object Dim txtname As String txtname = "export_file" Set fs = CreateObject(...
  • 将工作薄每一个工作表导出为PDF文件。   Sub PDF() Dim asy As Worksheet Dim spath As String spath = Excel.ThisWorkbook.Path For Each asy In Excel.ThisWorkbook.Worksheets sName = spath &...
  • 网上我也看到了很多的Powerdesigner 导出方法,因为Powerdesigner 提供了部分VBA功能,所以让我用代码导出Excel格式文件得以实现; 先看下效果图: 1.首先这个是PowerDesign待导出的文件 2.执行脚本后导出的...
  • 用QT调用VBA函数实现文件导出Excel功能
  • 双击该按钮进入VBA界面,输入以下代码:Private Sub CommandButton1_Click()Dim target As WorkbookDim path As Stringpath = ThisWorkbook.pathSet target = Workbooks.Open(Filename:=path & "\" & "test....
  • Excel VBA数据导出

    千次阅读 2017-08-14 18:12:09
    基于此需求,学习了ExcelVBA导出数据到文件中。 开启VBA Excel中的开发工具默认都没有打开,此处需要百度一下如何打开对应版本的Excel。(注:高版本的开发工具需要专业版或商业版才能使用,最好不要使用过高...
  • 应用场景1、下载或收发的工作表中存在图片,需要导出备份2、数据分析的数据图表,需要批量的导出图片附:视频知识要点1、Dir(path, vbDirectory)检查某些文件或目录是否存在,返回目录或文件夹名称2、Kill (path &...
  • 1、先给出原始excel文件,例如   2、本文工具将针对上述的评审文档,导出所有批注,且将批注生成一个新的sheet页,该sheet页跟评审文档在同一个文档中,如下格式: 3、生成如上的结果,只需要如下代码即可: ...
  • 使用Excel的VBProject可以导出文件中的VBA代码,但是有的文件有宏密码保护,导出就会报错。...把VBS放在要导出的文件夹下运行,遍历该路径下所有的Excel文件,并在放置VBS的路径生成Excel文件名的文件夹...
  • 用VB,VBA或者其他支持old的组建导出excel文件的时候,通常需要对文件格式进行排版和美化。这里面有两种做法,一,事先用一个设计好格式的excel,打开它往里面付值。 二,使用ole自己的划线和边框调整工具。下面具体...
  • 准备工作:下载压缩包解压–获得Classes下的所有文件https://github.com/PHPOffice/PHPExcel下面贴上代码,创建在index.php,引入需要的文件(注意路径自己改好)/*** 创建(导出)Excel数据表格* @param array $list 要...

空空如也

空空如也

1 2 3 4 5 ... 12
收藏数 232
精华内容 92
关键字:

vba导出excel文件