Excel VBA - ошибка времени выполнения '438'.Объект не поддерживает это свойство или метод - PullRequest
0 голосов
/ 10 октября 2018

Я новичок в VBA.У меня есть лист Excel, который дает мне время выполнения

Ошибка «438».Объект не поддерживает это свойство или метод.До сих пор все работало нормально.Любая помощь очень ценится.

Когда я нажимаю отладку, эта часть кода: 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 голосов
/ 10 октября 2018
    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"
...