在vba中将单个PNG文件转换为JPG



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

所以我需要一个"png2jpg"过程,在文件位置的PNG和保存一个JPG版本的文件在相同的位置和相同的名称。我希望有一个本地vba函数可以进行转换,但我找不到它(如果它存在)。

请尝试下一个代码:

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

最新更新