我是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的更改是否有任何更新。想知道是因为我们从未遇到过这个问题。
答案 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"