Excel VBA保存用户窗体图片至工作表时触发Runtime Error 438

问题根源分析 #

你遇到的错误直接出现在图片上传的代码段中，同时代码里还有几处潜在问题需要修正：

• 图片处理部分对OLEObject对象的属性调用有误，这是引发Error 438的直接原因
• 部分TextBox赋值未明确属性，存在类型错误风险
• 排序代码包含无效语句，且存在语法和引用问题

修正后的完整代码 #

Private Sub CommandSave_Click()
    'Save form data to new row and clear
    Dim ws As Worksheet
    Set ws = ActiveSheet

    'Save Textboxes to Worksheet
    Dim lr As Long
    lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row + 1

    ws.Cells(lr, "A").Value = Me.TextBox_1.Value
    ws.Cells(lr, "B").Value = Me.TextBox_2.Value
    '用Val()确保数值转换，避免文本类型相加出错
    ws.Cells(lr, "C").Value = Val(Me.TextBox_1.Value) + Val(Me.TextBox_2.Value)
    ws.Cells(lr, "D").Value = Me.TextBox_3.Value
    ws.Cells(lr, "E").Value = Me.TextBox_4.Value
    ws.Cells(lr, "G").Value = Me.TextBox_6.Value
    ws.Cells(lr, "H").Value = Me.TextBox_7.Value
    ws.Cells(lr, "I").Value = Me.TextBox_8.Value

    'Save image to Cell
    Dim ShpPicture As OLEObject
    With ws
        Set ShpPicture = .OLEObjects.Add(ClassType:="Forms.Image.1", _
            Link:=False, _
            DisplayAsIcon:=False, _
            Left:=.Cells(lr, "F").Left, _
            Top:=.Cells(lr, "F").Top, _
            Width:=Me.Image_1.Width, _
            Height:=Me.Image_1.Height)
    End With

    '修正属性调用，指向嵌入的Forms.Image对象
    With ShpPicture.Object
        .PictureSizeMode = 3 '对应fmPictureSizeModeZoom
        .Picture = Me.Image_1.Picture
    End With

    'Empty Textboxes
    TextBox_1.Value = ""
    TextBox_2.Value = ""
    TextBox_3.Value = ""
    TextBox_4.Value = ""
    TextBox_6.Value = ""
    TextBox_7.Value = ""
    TextBox_8.Value = ""

    'Sort Data on Two Fields
    ws.Sort.SortFields.Clear
    ws.Sort.SortFields.Add2 Key:=ws.Range("A8:A" & lr), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ws.Sort.SortFields.Add2 Key:=ws.Range("B8:B" & lr), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws.Sort
        .SetRange ws.Range("A8:I" & lr)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    'Resize cells to fit text
    ws.UsedRange.EntireColumn.AutoFit
    ws.UsedRange.EntireRow.AutoFit
End Sub

关键修正点说明 #

1. 图片属性修正：将ShpPicture.objects改为ShpPicture.Object（单数形式，指向嵌入的Forms.Image控件），同时把ObjectPicture改为Picture，这是解决Error 438的核心。
2. TextBox赋值优化：单元格C的赋值添加Val()函数，确保文本转数值后再相加，避免类型不匹配错误；同时明确所有TextBox的.Value属性。
3. 排序代码修复：删除无效的Sort_Two_columns A & B语句，在Clear方法后添加换行修复语法错误，所有Range对象绑定到ws工作表，避免引用混乱。
4. 最后一行判断优化：将Rows.Count改为ws.Rows.Count，确保在切换工作表时也能正确获取最后一行。

内容的提问来源于stack exchange，提问作者Bruce