Export pictures from excel file into jpg using VBA

后端 未结 7 1316
刺人心
刺人心 2020-11-27 07:17

I have an Excel file which includes pictures in column B and I want like to export them into several files as .jpg (or any other picture file format). The name of the file s

7条回答
  •  时光取名叫无心
    2020-11-27 07:37

    Thanks for the ideas! I used the above ideas to make a macro to do a bulk file conversion--convert every file of one format in a folder to another format.

    This code requires a sheet with cells named "FilePath" (which must end in a "\"), "StartExt" (original file extension), and "EndExt" (desired file extension). Warning: it doesn't ask for confirmation before replacing existing files with the same name and extension.

    Private Sub CommandButton1_Click()
        Dim path As String
        Dim pathExt As String
        Dim file As String
        Dim oldExt As String
        Dim newExt As String
        Dim newFile As String
        Dim shp As Picture
        Dim chrt As ChartObject
        Dim chrtArea As Chart
    
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    
        'Get settings entered by user
        path = Range("FilePath")
        oldExt = Range("StartExt")
        pathExt = path & "*." & oldExt
        newExt = Range("EndExt")
    
        file = Dir(pathExt)
    
        Do While Not file = "" 'cycle through all images in folder of selected format
            Set shp = ActiveSheet.Pictures.Insert(path & file) 'Import image
            newFile = Replace(file, "." & oldExt, "." & newExt) 'Determine new file name
            Set chrt = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) 'Create blank chart for embedding image
            Set chrtArea = chrt.Chart
            shp.CopyPicture 'Copy image to clipboard
            With chrtArea 'Paste image to chart, then export
                .ChartArea.Select
                .Paste
                .Export (path & newFile)
            End With
            chrt.Delete 'Delete chart
            shp.Delete 'Delete imported image
    
            file = Dir 'Advance to next file
        Loop
    
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
    
    
    End Sub
    

提交回复
热议问题