Question

我一直在尝试使用vba将我在.png文件夹中的一些文件转换为.jpg，但我最终无法使用代码来执行此操作，我一直在尝试将图像粘贴到Excel并将它们导出为jpg，但它似乎不起作用，任何人都可以帮我解决这个问题吗？我有代码，我试图这样做我在这一行收到错误

ThisWorkbook.ActiveSheet.ChartObjects("foto").Chart.Export Filename:=x, FilterName:="JPEG"

因为“此成员只能加入图表对象” 有人可以帮帮我吗？

On Error Resume Next
    DisplayAlerts = True
    Application.ScreenUpdating = True
    Dim Pathh As String
    Dim fila As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Pathh = "C:\Users\jojeda\Desktop\Pruebas JPEG\"
    Set carpeta = fso.getfolder(Pathh)
    Set ficheros = carpeta.Files
    For Each ficheros In ficheros
    'I belive the code should be here

b = "C:\Users\jojeda\Desktop\Pruebas JPEG\" & ficheros.Name
        With ThisWorkbook.ActiveSheet.Pictures.Insert(b)
        .Placement = 1
        .Name = "foto"
        .PrintObject = True
        End With
        ThisWorkbook.Worksheets("Sheet1").Cells(1, 6) = b
        ThisWorkbook.Worksheets("Sheet1").Range("F1").Replace ".png", ".jpg", xlPart
        b = ThisWorkbook.Worksheets("Sheet1").Cells(1, 6)
        x = Right(b, 8)


    ThisWorkbook.ActiveSheet.ChartObjects("foto").Chart.Export Filename:=x, FilterName:="JPEG"
    ThisWorkbook.Sheets("Sheet1").Shapes("foto").Delete
       Next ficheros

DisplayAlerts = True
Application.ScreenUpdating = True

Answer 1

我想出了一个解决我自己问题的方法，我最终将图片加载到图表中，然后将文件作为JPEG文件导出到另一个文件夹中，以防有人在寻找这样的东西，这就是代码：

Sub Button1_Click()
DisplayAlerts = True
    Application.ScreenUpdating = True
    Dim Pathh As String
    Dim fila As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Pathh = "C:\Users\jojeda\Desktop\Pruebas JPEG\"
    Set carpeta = fso.getfolder(Pathh)
    Set ficheros = carpeta.Files
    For Each ficheros In ficheros
        b = "C:\Users\jojeda\Desktop\Pruebas JPEG\" & ficheros.Name
        c = "C:\Users\jojeda\Desktop\Pruebas JPEG2\" & ficheros.Name
       Set blab = ThisWorkbook.ActiveSheet.ChartObjects.Add(Left:=200, Width:=200, Top:=80, Height:=200)
       blab.Name = "foto"
       blab.Activate
        ActiveChart.ChartArea.Format.Fill.UserPicture (b)
        ThisWorkbook.Worksheets("Sheet1").Cells(1, 6) = b
        ThisWorkbook.Worksheets("Sheet1").Range("F1").Replace ".png", ".jpeg", xlPart
        b = ThisWorkbook.Worksheets("Sheet1").Cells(1, 6)
    ThisWorkbook.Worksheets("Sheet1").ChartObjects("foto").Chart.Export Filename:=c, FilterName:="JPEG"
    ThisWorkbook.Sheets("Sheet1").Shapes("foto").Delete
       Next ficheros

DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

如何将多个png文件转换为jpeg

1 个答案: