运行时错误 ’-2147024809 （80070057）：参数错误

Albert-Qian

编写了一段批量调整图片尺寸的代码，运行后只有第一张图片处理成功了，弹出错误提示：“运行时错误 ’-2147024809 （80070057）：参数错误”，调试后提示Set Img = IP.Apply(Img)这句出问题了，但是不知道问题出在哪里。有哪位好心人帮忙看一下吗？

Sub piczoom()
'#####设置固定数值的宽高等比列缩放图片
Dim Img 'As ImageFile
Dim IP 'As ImageProcess
Dim arr()
irow = Range("a65536").End(xlUp).Row
arr = Range("a1:d" & irow)

Set Img = CreateObject("WIA.ImageFile")
Set IP = CreateObject("WIA.ImageProcess")

For i = 2 To irow
    Img.LoadFile arr(i, 1)
    IP.Filters.Add IP.FilterInfos("Scale").FilterID
        w = Img.Width
        h = Img.Height
        k = h / w

        IP.Filters(1).Properties("MaximumWidth") = arr(i, 4) * k
        IP.Filters(1).Properties("MaximumHeight") = arr(i, 4) * k
    Set Img = IP.Apply(Img)
    Img.SaveFile Left(arr(i, 1), InStrRev(arr(i, 1), "\")) & arr(i, 3) & ".jpg"

Next

End Sub

Datous

next 上面加一句

IP.Filters.Remove 1

https://docs.microsoft.com/en-us ... aut-ifilters-remove

Filters.Remove( _
  ByVal Index As LONG _
) As HRESULT

Albert-Qian

Datous 发表于 2020-10-26 17:50
next 上面加一句

IP.Filters.Remove 1

按照您的指点，问题解决了，十分感谢！

咕噜咕噜233

Datous 发表于 2020-10-26 17:50
next 上面加一句

IP.Filters.Remove 1

您好！想请教您个问题
您能看一下我这个为什么报错吗？想做地图热力图
Sub heatmap()
    Dim arr(1 To 10)
    With ActiveSheet
        Rem 设置颜色所在单元格区域，
        For Each Rng In .Range("H2:H6") '设置颜色所在单元格区域
        i = i + 1
        arr(i) = Rng.Interior.Color
        Next
        
        For Each Rng In .Range("A2:A33") '设置数据源中的分析对象所在单元格区域
        
            Rem 对各省的图形使用对应编号的颜色填充
            
            .Shapes(Rng.Value).Fill.ForeColor.RGB = arr(Rng.Offset(, 2).Value)
            
        Next
        
    End With

End Sub

djp1018

请问大师这个咋个处理？谢谢！

djp1018

djp1018 发表于 2023-11-8 10:30
请问大师这个咋个处理？谢谢！

Sub pic()
Dim Shp As Shape, Rg_zp As Range, ksh As String, sht As Worksheet, Ppath As String, oldrg As Range
Set sht = Sheets("在校生档案信息")
Ppath = ThisWorkbook.Path & "\证件批量打印\"
For Each Shp In sht.Shapes
    If Shp.Name Like "ksh_*" Then Shp.Delete
Next
On Error Resume Next
Set Rg_zp = sht.Cells.Find(What:="照片", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False)
Set oldrg = Rg_zp
While Not Rg_zp Is Nothing
    ksh = Rg_zp.Offset(17, 0).Value
    With sht.Pictures.Insert(Ppath & ksh & ".jpg")
        .Name = "ksh_" & ksh
        .Top = Rg_zp.Top
        .Left = Rg_zp.Left
        .Width = Rg_zp.Width * 0.45
    End With
    Set Rg_zp = sht.Cells.FindNext(Rg_zp)
    If Rg_zp.Address = oldrg.Address Then Exit Sub
Wend

End Sub

jaxxcyh

djp1018 发表于 2023-11-8 10:30
Sub pic()
Dim Shp As Shape, Rg_zp As Range, ksh As String, sht As Worksheet, Ppath As String, old ...

For Each Shp In sht.Shapes
    If Shp.Name Like "ksh_*" Then Shp.Delete
Next

不能改变循环变量本身，否则影响后面的循环。