Convert a single png file to jpg in vba

Question

I must reduce the size of image files before further processing as part of a larger VBA script. Since they are in PNG format, I don't mind the high level of compression.

In order to save a jpg version of the file in the same directory and with the same name, I need a "png2jpg" process that accepts the path of the png file. I had hoped that a native VBA function could perform the transition, but I can't seem to find one (if it exists).

Answer 1

Try this code:

Sub ConveretPNGToJpg()
    Dim strFolder As String, strExpFld As String, fso As Object, file As Object, folderObj As Object
    Dim fila As Integer, ch As ChartObject, strExt As String, ws As Worksheet, boolOrigSize As Boolean
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    strFolder = ThisWorkbook.path & "\" 'the folder where from the png files to be taken
    strExpFld = strFolder & "\TestJpg\" 'the folder where the jpg files will be exported
    Set folderObj = fso.GetFolder(strFolder)
    
    Set ws = ActiveSheet
    boolOrigSize = True 'keep the pictures original size!

    Set ch = ThisWorkbook.ActiveSheet.ChartObjects.Add(left:=200, width:=200, top:=80, height:=200)
    ch.Activate

    For Each file In folderObj.files
        strExt = fso.GetExtensionName(file)
        If strExt = "png" Then
            'if you need keeping the original size, the picture must be initialy added to the sheet and adjust the chart dimensions:
            If boolOrigSize Then
                Dim sh As Shape
                Set sh = ws.Shapes.AddPicture(file, True, True, 10, 10, -1, -1)
                With ch
                    ch.width = sh.width: ch.height = sh.height
                End With
                sh.CopyPicture: ch.Activate: ActiveChart.Paste: sh.Delete
            Else
                'fixed size:
                ch.Chart.ChartArea.Format.Fill.UserPicture (strFolder & file.Name)
            End If
            ch.Chart.Export fileName:=strExpFld & Replace(file.Name, strExt, "jpg"), FilterName:="JPEG"
        End If
    Next file
    ch.Delete
    MsgBox "Ready..."
End Sub