السلام عليكم
الاخ
Amhateb
الكود في الورقه الاولى
Dim DataRange As Range
Dim c As Range
Dim count As Integer
Dim o As Shape
On Error GoTo errhandler
For Each o In ActiveSheet.Shapes
If o.Name Like "InvalidData_*" Then o.Delete
Next
Set DataRange = Cells.SpecialCells(xlCellTypeAllValidation)
count = 0
For Each c In DataRange
If Not c.Validation.Value Then
Set o = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height)
o.Fill.Visible = msoFalse
o.Line.ForeColor.SchemeColor = 10
o.Line.Weight = 1
count = count + 1
o.Name = "InvalidData_" & count
End If
Next
Exit Sub
errhandler:
End Sub
السلام عليكم
لقد قفلت ملفك بكلمه مرور
لذلك طبقت على ملف اخر
انسخ الكود الى ملفك
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column < 15 Or Target.Column > 17 Then
ActiveSheet.Protect
Else
ActiveSheet.Unprotect
End If
End Sub
ان اردت ممكن تضع كلمه مرور
O_P_Q.rar
السلام عليكم
هنا ان كان الارقام (وليس النص ) غير ناتجه عن معادلة
و الا سيكون الحل بطريقه اخرى انفذها ان شئت
عدلت على المشاركه
الملف الاول ينفذ على عمود و الثانى على صف
test_it_1.rar
test_it_2.rar
السلام عليكم
دبل كلك فى القائمه الاولى على الاسم المراد ترحيله يرحل اىل القائمه الثانيه فورا
للتراجع عن اسم تم اختياره دبل كلك عليه يعود للقائمه الاولى
و هناك زر الترحيل
و يمكن حمل ترحيل بطريقه اخرى حيث بمجرد اختيار اسم يتم ترحيله للورقه فورا دون الحاجه لقائمه اخرى
names.rar