تركيب محرك بحث

[أبو شرف]

السلام عليكم 

اخواني اخذت هذا المحرك من احدى المشاركات في المنتدى الكريم وحقيقة ركبت محرك البحث على ورقتي ولكن لم استطيع ان اجعله يقرأ من القائمة في الشيت الأخر وحسب ما هو موضح بالملف وتقبلوا تقدير 

تكاليف-الجرف.rar

[أبو شرف]

اخواني الأ‘عزاء واساتذتنا الكرام . جهودكم مشكورة معنا  بأذن الله . لانهاء محرك البحث وتركيبه للعمل كذلك لم تم توضيح تركيبه على اي عامود او انفتاحة على اثر من عامود سوف يعم فائدة كبيرة وخصوصا للحسابات واستداعاء الأسعار ويكون القلب النابض لبعض المعادلات . نأمل منكم المساعدة قدر الأمكان . واشكركم 

تم تعديل أبريل 5, 2018 بواسطه أبو شرف

[أبو شرف]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
If Target.Column = 5 And Target.Row > 11 Then
 Cancel = True
   Dim B, D As String
   
   B = InputBox("أدخل عدد الصفوف المراد إضافتها", "تحديد عدد الصفوف المراد إضافتها", "1")
   If B = "" Or B = False Then Exit Sub
    ActiveCell.Offset(1).EntireRow.Resize(B).Insert
    ActiveCell.EntireRow.Copy ActiveCell.EntireRow.Offset(1).Resize(B).EntireRow
    On Error Resume Next
    ActiveCell.Offset(1).EntireRow.Resize(B).SpecialCells(xlConstants).ClearContents
    ActiveCell.Offset(1).EntireRow.Resize(B).RowHeight = 34
    ActiveCell.Select
    Selection.Offset(1, -4).Select
   End If
    On Error GoTo 0
If Target.Column = 1 Then
Cancel = True
    KH_T_SEARSH.Show
    On Error GoTo 0
    End If
If Target.Column = 2 And Target.Row > 12 Then
Cancel = True
ActiveCell = ActiveCell.Offset(-1, 0)
ActiveCell.Offset(0, -1) = ActiveCell.Offset(-1, -1)
ActiveCell.Offset(0, 1).Select
On Error GoTo 0
End If
If Target.Column = 6 And Target.Row > 11 Then
Cancel = True
ActiveCell.ClearContents
ActiveCell = [R8].Value
ActiveCell.Offset(0, 1).Select
End If
If Target.Column = 3 And Target.Row > 11 Then
Cancel = True
Cost_Centers_Search.Show
End If
If Target.Column = 7 And Target.Row > 11 Then
Cancel = True
Description_Search.Show
End If
On Error GoTo 0
If Target.Column = 4 And Target.Row > 12 Then
Cancel = True
ActiveCell = ActiveCell.Offset(-1, 0)
ActiveCell.Offset(0, -1) = ActiveCell.Offset(-1, -1)
ActiveCell.Offset(0, 1).Select
On Error GoTo 0
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
 Dim sRng As Range
Set sRng = Range("MY_PROTECT")
If Intersect(Target, sRng) Is Nothing Then Exit Sub
If Target = Intersect(Target, sRng) Then
    On Error GoTo Done
    Application.EnableEvents = False
    Application.Undo
MsgBox ("هذا النطاق محمي ولايمكن حذف أو تعديل محتواه")
Done:
 Application.EnableEvents = True

End If
End Sub

اخواني الأعضاء بالكروب . ممكن لو تكرمتم بشرح بسيط حول كيفية تحويل الكود على الملف اعلاه او اي شرح وتوضيحات على الكود اكون شاكر فضلكم وبارك الله بكم 

[Ali Mohamed Ali]

جرب هذا أخى الكريم

 

تكاليف-الجرف.xlsm

[أبو شرف]

عاشششششششششششششششششششت ايدك استاذ وبارك الله في جهودك . حليت لنا مشكلة كبييييييييييرة وربي يحفظك ويجعلها في ميزان حسناتك . ولجميع اعضاء الكروب الكرام 

اخوكم 

ابو شرف