Excel VBA-运行时错误'438'。对象不支持此属性或方法

时间:2018-10-10 20:22:59

标签: excel vba excel-vba subroutine

我是VBA的新手。我有一个可以给我运行时的excel工作表

  

错误“ 438”。对象不支持此属性或方法。到目前为止,它一直运行良好。   非常感谢您的帮助。

当我按debug时,这部分代码:Selection.OnAction = "ADDOTHERMATL"以黄色突出显示。

Dim QtyTblRange As String
              QtyTblRange = Worksheets("Errors").UsedRange.Offset(MaxRowNum, 0).Resize(2, (n + 2)).Address
        Worksheets("Errors").ListObjects.Add(xlSrcRange, Worksheets("Errors").Range(QtyTblRange), , xlYes).Name = "QtyErrors"

          MaxRow = Worksheets("JobNumConvert").Range("C" & Worksheets("JobNumConvert").Cells(Worksheets("JobNumConvert").Rows.Count, "C").End(xlUp).Row).Address
          Sheets("JobNumConvert").Range("C3:" & MaxRow).Copy

          MaxRow = Worksheets("Errors").Range("A" & Worksheets("Errors").Cells(Worksheets("Errors").Rows.Count, "A").End(xlUp).Row).Address
          Sheets("Errors").Range(MaxRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

          Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n + 1), Criteria1:="<>0", Operator:=xlAnd

               Worksheets("Errors").Cells.EntireColumn.AutoFit

        ActiveWorkbook.Worksheets("Syteline - Job Materials").ListObjects("JobAggregateTable").Sort.SortFields.Clear
        Worksheets("Syteline - Job Materials").ListObjects(1).AutoFilter.ShowAllData

        Worksheets("Errors").Buttons.Add(350, 10, 200, 25).Select
        ***Selection.OnAction = "ADDOTHERMATL"***
        Selection.Characters.Text = "Add Other Matl to Entry Sheet"
        With Selection.Characters(Start:=1, Length:=29).Font
            .Name = "Arial"
            .FontStyle = "Regular"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With

        Worksheets("Errors").Range("A4").FormulaR1C1 = "BOM Errors: Results in this Table indicate that Syteline's standard BOM expects a material value where the HRB results reported none."
        Worksheets("Errors").Range("A4").Font.Bold = True

        Worksheets("Errors").Range(MaxRow).Offset(-2, 0).FormulaR1C1 = "Qty Errors: Results in this Table are filtered to display instances where the HRB material totals and the Entry Sheet Material totals differ."
        Worksheets("Errors").Range(MaxRow).Offset(-2, 0).Font.Bold = True

        Worksheets("Errors").Range("A1").Activate

    End Sub
    Sub ADDOTHERMATL()

    n = Worksheets("Errors").ListObjects("QtyErrors").ListColumns("Other Matl").Index

    Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n), Criteria1:="<>", Operator:=xlAnd

    MaxRowNum = Worksheets("Entry Sheet").Range("B" & Worksheets("Entry Sheet").Cells(Rows.Count, "B").End(xlUp).Row).Row + 1
    Dim OtherRows
            With Worksheets("Errors").ListObjects("QtyErrors")
            For Each Line In .Range.SpecialCells(xlCellTypeVisible).Areas
                OtherRows = OtherRows + Line.Rows.Count
            Next
        End With

            If OtherRows <= 1 Then
                Worksheets("Errors").ListObjects("QtyErrors").Sort.SortFields.Clear
                Worksheets("Errors").ListObjects("QtyErrors").AutoFilter.ShowAllData
                Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n - 1), Criteria1:="<>0", Operator:=xlAnd
                MsgBox "No Other Material(s) selected.": Exit Sub
            End If

        OtherRows = (OtherRows + MaxRowNum - 2)

           Sheets("Entry Sheet").Range("B" & MaxRowNum & ":B" & OtherRows).FormulaR1C1 = 10

           Sheets("Errors").Range("QtyErrors[Other Matl]").SpecialCells(xlCellTypeVisible).Copy
           Sheets("Entry Sheet").Range("C" & MaxRowNum & ":C" & OtherRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

           Sheets("Errors").Range("QtyErrors[HRB Other Qty]").SpecialCells(xlCellTypeVisible).Copy
           Sheets("Entry Sheet").Range("E" & MaxRowNum & ":E" & OtherRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

           Sheets("Entry Sheet").Range("F" & MaxRowNum & ":F" & OtherRows).FormulaR1C1 = "LBS"

           Sheets("Entry Sheet").Range("H" & MaxRowNum & ":H" & OtherRows).FormulaR1C1 = "MAIN"

           Sheets("Entry Sheet").Range("I" & MaxRowNum & ":I" & OtherRows).FormulaR1C1 = "9999999"

           Sheets("Entry Sheet").Range("J" & MaxRowNum & ":J" & OtherRows).FormulaR1C1 = "Data, Entry"

           Sheets("Entry Sheet").Range("K" & MaxRowNum & ":K" & OtherRows).FormulaR1C1 = "Pending"

           Sheets("Entry Sheet").Range("L" & MaxRowNum & ":L" & OtherRows).FormulaR1C1 = 1

           Sheets("Entry Sheet").Range("M" & MaxRowNum & ":M" & OtherRows).FormulaR1C1 = 1

           Sheets("Entry Sheet").Range("N" & MaxRowNum & ":N" & OtherRows).FormulaR1C1 = "= TODAY()-1"

           Sheets("Errors").Range("QtyErrors[Pallet]").SpecialCells(xlCellTypeVisible).Copy
           Sheets("Entry Sheet").Range("Q" & MaxRowNum & ":Q" & OtherRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

           Sheets("Entry Sheet").Range("O" & MaxRowNum & ":O" & OtherRows).FormulaR1C1 = "=""     "" & LEFT(RC[2],5)"

           Sheets("Entry Sheet").Range("P" & MaxRowNum & ":P" & OtherRows).FormulaR1C1 = "=SUBSTITUTE(RIGHT(RC[1],2), 0, """")"

           Sheets("Entry Sheet").Range("R" & MaxRowNum & ":R" & OtherRows).FormulaR1C1 = "1"

           Sheets("Entry Sheet").Range("G" & MaxRowNum & ":G" & OtherRows).FormulaR1C1 = "=IF(LEFT(INDEX(Summary!C[-6],MATCH('Entry Sheet'!RC[10],Summary!C[4],0)),1)=""P"",""Poplar - STOCK"",""STOCK"")"

        With Sheets("Entry Sheet").UsedRange
                .Copy
                .PasteSpecial xlPasteValues
        End With

        Worksheets("Entry Sheet").Range("A" & MaxRowNum & ":R" & OtherRows).Style = "40% - Accent5"

        Worksheets("Entry Sheet").Range("A1:R" & OtherRows).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlYes

        Worksheets("Errors").ListObjects("QtyErrors").Sort.SortFields.Clear
        Worksheets("Errors").ListObjects("QtyErrors").AutoFilter.ShowAllData
        Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n - 1), Criteria1:="<>0", Operator:=xlAnd


    OtherRows = (OtherRows - MaxRowNum) + 1

    Worksheets("Errors").Activate

    MsgBox "" & OtherRows & " Other Material Entries have been successfully inserted into the Entry Sheet Results."

    End Sub

对Excel的更改是否有任何更新。想知道是因为我们从未遇到过这个问题。

1 个答案:

答案 0 :(得分:2)

    Worksheets("Errors").Buttons.Add(350, 10, 200, 25).Select
    Selection.OnAction = "ADDOTHERMATL"

您假设Worksheets("Errors")ActiveSheet,因为Selection仅引用活动工作表上的选定对象。

相反,保留对添加按钮的引用-Add方法返回该对象:

Dim button As Object
Set button = Worksheets("Errors").Buttons.Add(350, 10, 200, 25)

现在设置其OnAction属性:

button.OnAction = "ADDOTHERMATL"