خطأ وقت التشغيل ‘1004’ خطأ معرف بالتطبيق أو معرف بالكائن في VBA excel

برمجة


لقد قمت بكتابة رمز لإنشاء قائمة منسدلة ديناميكية بدون أي فراغ
وهو يعمل بشكل جيد جدًا، ولكن المشكلة الوحيدة هي عندما أقوم بتشغيل العلامة أثناء النقر فوق أي كائن (صور، أزرار، إلخ.) فإنه يظهر خطأ وقت التشغيل ‘1004’ خطأ معرف بالتطبيق أو خطأ محدد بالكائن

لقد استخدمت مصحح الأخطاء في VBA ويظهر الخطأ في هذين الاثنين

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
     xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")

وهذا هو الكود كاملا أرجو المساعدة

Sub DynamicDropDown()
    Dim sourceSheet As Worksheet
    Dim destinationSheet As Worksheet
    Dim sourceRange As Range
    Dim destinationRange As Range
    Dim cell As Range
    Dim validationFormula As String
    Dim nonBlankValues As Collection
    Dim dropDownCell As Range
    
    ' Set source and destination sheets
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set destinationSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Define the source range (adjust the range as needed)
    Set sourceRange = sourceSheet.Range("A1:A" & sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row)
    
    ' Define the destination range where you want the drop-down list
    Set destinationRange = destinationSheet.Range("N10")
    
    
    ' Create a collection to store non-blank values
    Set nonBlankValues = New Collection
    
    ' Collect non-blank values from the source range
    On Error Resume Next
    For Each cell In sourceRange
        If cell.Value <> "" Then
            nonBlankValues.Add cell.Value, CStr(cell.Value)
        End If
    Next cell
    On Error GoTo 0
    
    ' Convert the collection to an array
    Dim valuesArray() As Variant
    ReDim valuesArray(1 To nonBlankValues.Count, 1 To 1)
    
    Dim i As Integer
    For i = 1 To nonBlankValues.Count
        valuesArray(i, 1) = nonBlankValues(i)
    Next i
    
    ' Set the validation formula
    
    destinationRange.Validation.Delete
    With destinationRange.Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    
End Sub

ما حاولت:

لقد حاولت كل ما أعرفه ولكن لا شيء يعمل

الحل 1

حاول تقسيم هذا الخط:

فبا
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
     xlBetween, Formula1:=Join(Application.Transpose(valuesArray), ",")

داخل:

فبا
Dim result As String
result  = Join(Application.Transpose(valuesArray), ",")
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
     xlBetween, Formula1:=result 

コメント

タイトルとURLをコピーしました