excel - 获取运行时错误 1004 - 对象“验证”的方法“添加”失败

Question

我正在尝试通过 vba 在我的 excel 表上添加数据验证列表。但是每隔几次我尝试运行此代码时，我不断收到运行时错误 1004 - 对象“验证”的方法“添加”失败。下面是完整的代码。

Option Explicit
Sub rwins()
Dim w As Workbook
Dim ws As Worksheet
Dim ButtonText As String
Dim fr1 As Long
Dim lr1 As Long
Dim i As Long
Dim wss As Worksheet
Dim cl As Range
Dim rr2 As Range
Dim fr2 As Long
Dim lr2 As Long
Dim cst As String
Dim r As Range
Dim v As String
Dim dtrr As Range
Dim cl2 As Range
Dim r2 As Range
Dim bt2 As Shape
Dim btc As Shape
Dim ld As Long
Dim ind As Range
Dim acr As Range
Dim cmb As Shape
Dim cmb2 As Shape
Dim j As Long

Set w = Workbooks("MCC_LEDGER.xlsm")
Set ws = w.ActiveSheet
Set wss = w.Worksheets("LIST")

fr1 = ws.UsedRange.Rows(ws.UsedRange.Rows(1).Count).Row
lr1 = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row
fr2 = wss.UsedRange.Rows(wss.UsedRange.Rows(1).Count).Row
lr2 = wss.UsedRange.Rows(wss.UsedRange.Rows.Count).Row

ButtonText = Application.Caller

For i = fr1 To lr1
 If StrComp(ButtonText, ws.Cells(i, 2).Value) = 0 Then
   Exit For
 End If
Next

ws.Range("A" & i + 4).EntireRow.Insert

ld = ldn + 1

With ws.Range("P" & i + 4)
  ws.Buttons.Add(.Left, .Top, .Width, .Height).Name = CStr(ld)
End With

Set btc = ws.Shapes(CStr(ld))

btc.AlternativeText = "Calculate amount,cess, bill amount etc."
btc.Select
Selection.Characters.Text = "CALCULATE" '<<--- calculate button          would come before ld. no. ideally for worksheet change event to work easily.

With Selection.Font
    .Name = "ArialNarrow"
    .Size = 10
End With
 
btc.OnAction = "'" & w.Name & "'!clc"

ws.Range("E" & i + 4) = Day(Date) '<<---- date would come before ld     no. for undo to function.
ws.Range("D" & i + 4) = ld

要添加数据验证的第一个范围名为“ind”

Set ind = ws.Range("F" & i + 4)

ind.Activate

With ind.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Operator:=_
 xlBetween, Formula1:="DEBIT,CREDIT"
End With
cst = ""
Set rr2 = wss.Range("B" & fr2 + 1, "B" & lr2)

For Each r In rr2
  If cst = "" Then
   cst = CStr(r.Value)
  Else
   cst = cst & "," & CStr(r.Value)
  End If
Next r

要添加验证的第二个范围名为“acr”

Set acr = ws.Range("G" & i + 4)

acr.Activate

With acr.Validation
 .Delete
 .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop,Operator:=_
 xlBetween, Formula1:=cst
End With

lr1 = ws.UsedRange.Rows(ws.UsedRange.Rows.Count).Row


With ws.Range("Q" & i + 4)
 ws.Buttons.Add(.Left, .Top, .Width, .Height).Name = CStr(ButtonText & "$" & ld)
End With

Set bt2 = ws.Shapes(CStr(ButtonText & "$" & ld))

bt2.AlternativeText = "Submit Entry"
bt2.Select
Selection.Characters.Text = "SUBMIT"

With Selection.Font
   .Name = "ArialNarrow"
   .Size = 12
End With
 
 bt2.OnAction = "'" & w.Name & "'!adentr"
 
 ws.Range("D" & i + 4).Select

 End Sub

更新 - 已按要求输入完整代码。

标签： excelvba