在vba中将单个png文件转换为jpg

Posted 2023-03-28

【中文标题】在vba中将单个png文件转换为jpg

【英文标题】：convert a single png file to jpg in vba

【发布时间】：2021-10-10 11:35:10

【问题描述】：

作为较大 VBA 脚本的一部分，我需要在进一步处理之前精简图像文件。它们是 PNG 格式，我可以承受很多压缩。

所以我需要一个“png2jpg”程序，它接收 png 的文件位置并将文件的 jpg 版本保存在同一位置并使用相同的名称。我希望有一个可以进行转换的本机 vba 函数，但我找不到它（如果它存在的话）。

【问题讨论】：

有可用的库。没有什么原生的。 imagemagick.org/script/ImageMagickObject.php 就是一个例子

您只能通过将它们加载并导出为 jpg 来转换它们。

“瘦身”是什么意思？你也减小图像尺寸吗？如果是，这个尺寸应该是标准的/相同的吗？

【参考方案1】：

请尝试下一个代码：

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

【讨论】：

@user2523167 没抽时间测试一下上面的代码吗？如果经过测试，它没有按您的需要工作吗？