[ad_1]
لقد قمت بكتابة رمز لإنشاء قائمة منسدلة ديناميكية بدون أي فراغ
وهو يعمل بشكل جيد جدًا، ولكن المشكلة الوحيدة هي عندما أقوم بتشغيل العلامة أثناء النقر فوق أي كائن (صور، أزرار، إلخ.) فإنه يظهر خطأ وقت التشغيل ‘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
[ad_2]
コメント