vba - 加载 JPEG 图片错误

Question

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

Run-time error 481 - Invalid picture

和类似的

Invalid picture

手动加载时的消息。

从我的互联网搜索中，我找到了大量关于此错误的建议；大多数帖子往往是因为 user is uploading a png或其他无效图像 ( such as a corrupt jpg ), some suggest我的 temp 文件夹已满，others think原因是病毒(我对最后一个表示怀疑)。

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

• 一张 jpg(MSDN lists as an acceptable format 在其 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

屏幕截图