Convert a single png file to jpg in vba

0 votes
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).
Oct 16, 2022 in Others by Kithuzzz
• 38,010 points
1,318 views

1 answer to this question.

0 votes

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
answered Oct 16, 2022 by narikkadan
• 63,700 points

Related Questions In Others

0 votes
1 answer

Convert excel file to jpg in c#

You can use Aspose : http://www.aspose.com/community/files/51/.net-components/aspose.cells-for-.net/category1129.aspx For example : http://www.aspose.com/docs/display/cellsnet/Converting+Worksheet+to+Image Sample ...READ MORE

answered Dec 27, 2022 in Others by narikkadan
• 63,700 points
826 views
0 votes
1 answer
0 votes
1 answer

Trying to import a CSV file and convert it into a table using VBA

You cannot convert a range that contains ...READ MORE

answered Apr 10, 2023 in Others by Kithuzzz
• 38,010 points
1,536 views
0 votes
1 answer
0 votes
1 answer

How to Convert Excel Cell Values Into Individual PNG Files?

This will: create a chart add an image to ...READ MORE

answered Dec 19, 2022 in Others by narikkadan
• 63,700 points
330 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
977 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
3,318 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 23,260 points
628 views
0 votes
1 answer

Convert image (jpg) to base64 in Excel VBA?

Heres a function. Can't remember where I ...READ MORE

answered Sep 27, 2022 in Others by narikkadan
• 63,700 points
2,336 views
0 votes
1 answer

Convert table in a jpg image to excel using python

I believe you must execute OCR (optical ...READ MORE

answered Oct 16, 2022 in Others by narikkadan
• 63,700 points
1,964 views
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP