مساعدة في كود تبديل رقم بنص

**محمد الورفلي1** · سبتمبر 23, 2014

السلام عليكم

ممكن تحدي عمل هذا الكود في العمود c فقط من c18:c2014

مع العلم هذا الكود يعمل بشكل ممتاز في جميع الخلاية ولكن اريدة فقط في العمود c

ياسر خليل أبو البراء · سبتمبر 23, 2014

تفضل أخي الحبيب :

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
    
End Sub

**محمد الورفلي1** · سبتمبر 23, 2014

الاخ ياسر شكراً

لكن عند وضع الكود مع كود موجود في نفس الورق اصبح في تظارب في الاكواد هل يمكن تغيير اسم الحدث (( الكود الموجود مسبقاً هو للفرز والتنقل مباشرة للخلية المطلوبة فكيف العمل مع ذالك

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
    
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
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
End Sub

**محمد الورفلي1** · سبتمبر 23, 2014

تم حل المشكلة للفائدة

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
    
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
End Sub

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

ياسر خليل أبو البراء · سبتمبر 24, 2014

الحمد لله أن تم الحل هل يمكنك إرفاق الملف للفائدة أخي الحبيب

**محمد الورفلي1** · سبتمبر 24, 2014

السلام عليكم

الاخ الكريم ياسر

الملف لم يكتمل بعد ارجو تصحيح ما تجده من اخطاء

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

هو ثلاث اجزاء 1/ كود وضع ارقام في خلية بدل من نصوص مثل تضع رقم (( 1 )) جعلتها ترمز الي اولي ابتداي وتستطيع تغييرها الي متشاء

2/ كود وضع حرف (( ك )) في خلية ترمز الي (( ذكر ))) و حرف ( ن ) الي انثى

3/ كود ابجدة تلقائي والا نتقال الي اخر خلية فارغة عند وضع اسم الطالب

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("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
End Sub

شئون بسيط.rar

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

ياسر خليل أبو البراء · سبتمبر 25, 2014

الأخ محمد الحبيب

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

**محمد الورفلي1** · سبتمبر 25, 2014

اعتقد ان صفحة كشف اسماء الطلبة لكل صف عندما يكون جلب الطلبة بالكواد افضل من طريقة التصفية لكن لقلة خبرتي بها فلم اعملها

تسجيل الدخول

مساعدة في كود تبديل رقم بنص

الردود الموصى بها

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

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

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

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

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

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

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

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

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information