طلب مساعده ( عند البحث عن رقم فى الشيت اجمالى هل يمكن

[zorp]

طلب مساعده 

 

( عند البحث عن رقم فى الشيت معين انا اقوم بعمليه ctrl+f

 

هل يمكن وضع كود او تخصيص خاصية تجعل الخليه التى تحتوى على رقم تظهر بالون مختلف 

 

مثال 

صوره فى المرفقات

http://im84.gulfup.com/rNCUYX.jpg

تم تعديل أكتوبر 20, 2014 بواسطه zorp

[سليم حاصبيا]

السلام عليكم

عسى ان ينال اعجابك

بحث عن رقم.rar

[zorp]

اشكرك جدا 

 

ولكن اتمنى توضح لى طريق عمله 

 

 

[محمد الورفلي1]

السلام عليكم  

 

 

شكراَ 

 

ممكن الانتقال الي الخلية التي بها الرقم ام لا وشكراَ مره اخرى وتكون نشطة

تم تعديل أكتوبر 23, 2014 بواسطه محمد الخازمي

[سليم حاصبيا]

 استاذ محمد

يمكن عمل ذلك بواسطة الماكرو

انظر الى المرفق

[ياسر خليل أبو البراء]

 استاذ محمد

يمكن عمل ذلك بواسطة الماكرو

انظر الى المرفق

روعة أخي وحبيبي في الله سليم

شكلك هتبقا الانتيم .. إني أحبك في الله

بارك الله فيك وجزاك الله خيرا وجعل أعمالك في ميزان حسناتك يوم القيامة

[محمد الورفلي1]

السلام عليكم

 

شكراً تمام جداَ  ..............  اسناذ سليم دائماَ اجد لديك حل لكل شي  اتعبتك مع (( احسنت ))

 

سؤال كيف ادمج هذا الكود  مع هذا الكود  

Private Sub ShockwaveFlash1_OnReadyStateChange(ByVal newState As Long)

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then
        Select Case Target
            Case 1
                Target = "Çæáí ÇÈÊÏÇÆí"
            Case 2
                Target = "ËÇäíÉ ÇÈÊÏÇÆí"
            Case 3
                Target = "ËÇáËÉ ÇÈÊÏÇÆí"
            Case 4
                Target = "ÇáÕÝ ÇáÑÇÈÚ"
            Case 5
                Target = "ÇáÕÝ ÇáÎÇãÓ"
            Case 6
                Target = "ÇáÕÝ ÇáÓÇÏÓ"
            Case 7
                Target = "ÇáÕÝ ÇáÓÇÈÚ"
            Case 8
                Target = "ÇáÕÝ ÇáËÇãä"
            Case 9
                Target = "ÇáÕÝ ÇáÊÇÓÚ"

        End Select
    End If
    If Not Intersect(Target, Range("d18:d2014")) Is Nothing Then
        Select Case Target
            Case "ß"
                Target = "ÐßÑ"
            Case "ä"
                Target = "ÇäËì"
            

        End Select
    End If


Application.ScreenUpdating = False
If Target.Column = 4 Or Target.Column > 8 Then GoTo 1
LR = Cells(Rows.Count, 2).End(xlUp).Row
If Range("B" & LR) = "" Or Range("C" & LR) = "" Or Range("d" & LR) = "" _
Or Range("e" & LR) = "" Then GoTo 1

    Range("b18:e" & LR).Select
    Selection.Sort Key1:=Range("b18"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'''''''''''''''''''''''''''''''''''''''''''''''
       With Range("b18:b" & LR + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
     
''''''''''''''''''''''''''''''''''''''''''''
      With Range("b18:b" & LR + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
      Range("b" & LR + 5).Select
1:
Application.ScreenUpdating = True

End Sub

تم تعديل أكتوبر 23, 2014 بواسطه محمد الخازمي

[حليم ناصر]

جزاكم الله خيرا

[ياسر خليل أبو البراء]

الأخ محمد الخازمي ارفق ملف به الكودين لمحاولة دمجهما

[محمد الورفلي1]

السلام عليكم

 

 

ها هوالملف معهة الكودين

 

وشكراً لك مسبقاً

                                                               

 

 

 

 

 

                                               جمع الكود.rar 

تم تعديل أكتوبر 24, 2014 بواسطه محمد الخازمي

[ياسر خليل أبو البراء]

أخي محمد

أنا شايف الكودين مدمجين بالفعل .. هل فيه رسالة خطأ بتظهر في سطر معين أو ما شابه؟

[محمد الورفلي1]

السلام عليكم

 

استاذ ياسر هذ ا الكود الاول وهو مكون من عدة اكواد انت من دمجتها لي من قبل اريد ان اضيف اليها الكود رقم 2

Private Sub ShockwaveFlash1_OnReadyStateChange(ByVal newState As Long)

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ""
If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then
        Select Case Target
            Case 1
                Target = "اولي ابتدائي"
            Case 2
                Target = "ثانية ابتدائي"
            Case 3
                Target = "ثالثة ابتدائي"
            Case 4
                Target = "الصف الرابع"
            Case 5
                Target = "الصف الخامس"
            Case 6
                Target = "الصف السادس"
            Case 7
                Target = "الصف السابع"
            Case 8
                Target = "الصف الثامن"
            Case 9
                Target = "الصف التاسع"

        End Select
    End If
    If Not Intersect(Target, Range("d18:d2014")) Is Nothing Then
        Select Case Target
            Case "ك"
                Target = "ذكر"
            Case "ن"
                Target = "انثى"
            

        End Select
    End If


Application.ScreenUpdating = False
If Target.Column = 4 Or Target.Column > 8 Then GoTo 1
LR = Cells(Rows.Count, 2).End(xlUp).Row
If Range("B" & LR) = "" Or Range("C" & LR) = "" Or Range("d" & LR) = "" _
Or Range("e" & LR) = "" Then GoTo 1

    Range("b18:e" & LR).Select
    Selection.Sort Key1:=Range("b18"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
'''''''''''''''''''''''''''''''''''''''''''''''
       With Range("b20:b" & LR + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
     
''''''''''''''''''''''''''''''''''''''''''''
      With Range("b20:b" & LR + 3)
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Font.Size = 18
      .Font.Bold = True
      End With
      Range("b" & LR + 5).Select
1:
Application.ScreenUpdating = True
ActiveSheet.Protect ""

End Sub

  الكود رقم 2  الذ اريد دمجه مع الاكواد المدمجة السابقة

 'Sub tor()
'Dim rg As Range
'Range("C18:C2014").ClearFormats
'For Each x In Range("C18:C2014")
    'If x.Value = [h10] Then
            'If rg Is Nothing Then
            'Set rg = x
            'Else
            'Set rg = Union(rg, x)
            'End If
    'End If
   
'Next
'If rg Is Nothing Then Exit Sub
'rg.Select
  'With Selection.Interior
        '.Pattern = xlSolid
        '.PatternColorIndex = xlAutomatic
        '.Color = 10092441
        
    'End With
'End Sub

'Private Sub Worksheet_Change(ByVal Target As Range)
'If Not Intersect(Target, Range("h10")) Is Nothing Then
'tor
'End If
'End Sub

[محمد الورفلي1]

السﻻم علبكم

من لديه فكرة لدمج الكودين