加载 JPEG 图片错误

Question

已经有很多关于此错误的帖子，但我似乎找不到解决方案；当以编程方式（使用函数）将图片加载LoadPicture()到用户窗体上的图像控件时，出现此错误：

运行时错误 481 - 无效图片

和一个类似的

图片无效

手动加载时的消息。

从我的互联网搜索中，我找到了大量关于此错误的建议；大多数帖子往往是因为用户上传了 png或其他无效图像（例如损坏的 jpg），有些帖子表明我的temp文件夹已满，其他帖子则认为是病毒造成的（我对最后一个表示怀疑）。

在我的应用程序中，我的图片是

• jpg（ MSDN在其文章的备注部分将其列为可接受的格式LoadPicture()）

• 没有损坏（至少，我可以用 windows photoviewer/Chrome/Paint 查看它）

• 相对较小（例如，它是 ~1MPx 和 200MPx jpeg，我测试加载时没有任何错误）

唯一有点不寻常的是，我使用以下代码直接从网络下载此文件：

Public Declare Function URLDownloadToFile Lib "urlmon" _
    Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long 'api to download files

Sub setPicTest()
    Dim tmpImg As MSForms.Image 'create an image control on UserForm1 at runtime
    Set tmpImg = UserForm1.Controls.Add("Forms.Image.1")
    tmpImg.Picture = getImg("https://s-media-cache-ak0.pinimg.com/originals/22/e2/4d/22e24d3b5703a1c1cc43df5b13f53fd2.png")
End Sub

Function getImg(url As String) As IPictureDisp 'loads a picture from a url
    Dim strFile As String 'file save location
    strFile = Environ("Temp") & "\Temp.jpg" 'save *as jpeg* in %temp% folder
    Debug.Print URLDownloadToFile(0, url, strFile, 0, 0) 'download file to temp folder
    Set getImg = LoadPicture(strFile) 'load image -error-
    Kill strFile 'clean up temp file
End Function

当我逐步执行时，一切都按预期进行

• 我的用户窗体上出现一个空（无图片）图像控件
• 一个名为的文件temp.jpg出现在我的临时文件夹中
  • 该文件似乎没有损坏

但随后代码执行因错误而中断。这是特别令人惊讶的，因为代码对于小缩略图图像一直工作得很好，只是这些全分辨率图像似乎不起作用。

Answer 1

它是一个 png 文件。将其重命名为 jpg 没有帮助。URLDownloadToFile下载一个文件。它不会更改文件类型。

话虽如此，这是实现您想要的目标的一种方法；）

逻辑：

1. 插入临时工作表
2. 将图像直接插入工作表中
3. 插入图表
4. 将图像复制到图表并将其导出为.Jpg
5. 使用加载图像LoadPicture
6. 删除我们创建的对象和临时文件。

代码

Sub setPicTest()
    Dim wsTemp As Worksheet
    Dim tmpImg As MSForms.Image
    Dim PicPath As String, tmpPath As String
    Dim oCht As Chart

    Set tmpImg = UserForm1.Controls.Add("Forms.Image.1")

    Set wsTemp = ThisWorkbook.Sheets.Add

    '~~> This is the .PNG image
    PicPath = "https://s-media-cache-ak0.pinimg.com/originals/22/e2/4d/22e24d3b5703a1c1cc43df5b13f53fd2.png"
    '~~> This will be the .JPG image
    tmpPath = Environ("Temp") & "\Temp.jpg"

    With wsTemp
        .Pictures.Insert(PicPath).ShapeRange.LockAspectRatio = msoTrue
        DoEvents
        Set oCht = Charts.Add
        .Shapes(1).CopyPicture xlScreen, xlBitmap

        With oCht
            .Paste
            .Export Filename:=tmpPath, Filtername:="JPG"
        End With
        DoEvents

        tmpImg.Picture = LoadPicture(tmpPath)

        '~~> Clean Up
        On Error Resume Next
        Application.DisplayAlerts = False
        .Delete
        oCht.Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
    End With

    '~~> Delete the temp image
    Kill tmpPath
End Sub

编辑

出于测试目的，我使用了这些设置

Set tmpImg = UserForm1.Controls.Add("Forms.Image.1")

With tmpImg
    .Left = 20        '~~> This property does not shown in Intellisense
    .Width = 300      '~~> This property does not shown in Intellisense
    .Height = 300     '~~> This property does not shown in Intellisense
    .Top = 10         '~~> This property does not shown in Intellisense

    .PictureAlignment = fmPictureAlignmentCenter
    .PictureSizeMode = fmPictureSizeModeStretch
End With

截屏