【问题标题】:How to convert multiple png files to jpeg如何将多个png文件转换为jpeg
【发布时间】:2017-05-29 23:53:03
【问题描述】:

我一直在尝试使用 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

【问题讨论】:

  • 避免使用On Error Resume Next,因为它只会忽略错误消息(请参阅VBA Best Practices - Error Handling)。删除该行并将/edit 添加到您遇到错误的问题(哪一行)以及您遇到的错误。
  • 谢谢,我刚刚编辑了问题,现在我可以看到错误在哪里,但我不知道该怎么做?

标签: vba excel png jpeg


【解决方案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

【讨论】:

  • 您可以接受自己的答案作为解决方案。所以任何人都可以看到这个问题已经解决了。
  • Thaks Peh,我在解决问题时尝试过,但我必须等待 2 天才能接受我自己的答案:(
猜你喜欢
  • 2012-12-22
  • 2011-01-18
  • 1970-01-01
  • 2016-08-11
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-09-09
  • 2022-08-22
相关资源
最近更新 更多