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

اريد جمع هذان الكودين 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 جمع الكود.rar

السﻻم علبكم من لديه فكرة لدمج الكودين

السلام عليكم الاستاذ الفاضل ((( مجدي يونس )) ملف جميل وان شاء الله في ميزان حسناتك الواضح انك تعبت علية كثير جداَ نسال الله ان يتقبلة في ميزان حسناتك

السلام عليكم استاذ ياسر هذ ا الكود الاول وهو مكون من عدة اكواد انت من دمجتها لي من قبل اريد ان اضيف اليها الكود رقم 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

السلام عليكم ها هوالملف معهة الكودين وشكراً لك مسبقاً جمع الكود.rar

السلام عليكم شكراً تمام جداَ .............. اسناذ سليم دائماَ اجد لديك حل لكل شي اتعبتك مع (( احسنت )) سؤال كيف ادمج هذا الكود مع هذا الكود 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

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

السلام عليكم جميل جداً شكراً

السلام عليكم فكرة جميلة يا استاذ طارق بارك الله فيك

للرفع

السلام عليكم شكراَ

للرفع

السلام عليكم لدي فورم يتظارب مع خلية بها كود اريد التوافق مع بعضهما اذ امكن ذالك فورم تعديل فصول لكل عام دراسي.rar

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

السلام عليكم استاذ سليم مبروك الترقية اكوادك دائماَ جميلة وممتعة وإن شاء الله في ميزان حساناتك

جميل جداً

شكراً استاذ محمد علي المعلومة

ممكن ارفاق مثال 2003 لتعم الفائدة

اخي محمد ماهي المشكلة في الملف هل هناء امر معين لابد من اضافته الي 2003

السلام عليكم ورحمة الله اخي محمد ياريت 2003

السلام عليكم ورحمة الاخ الفاضل (( ياسر خليل )) جزاكم الله خيرا نسأل الله العلي القدير ان تكون في ميزان حسناتك وينتفع بها الناس شكراً لك

السلام عليكم ورحمة الله اخي محمد فعلن مها قلنا لن نوفيهم حقهم من هم همهم مساعدة الناس (( فخير الناس انفعهم للناس )) فبارك االه فيك اخي محمد في هذه الكلمات الطيبة

السلام عليكم بارك الله فيك (( استاذ محمود استمر في هذه الدروس التعليمية // هذا مانريد تعلمه منكم نسأل الله ان تكون لك صدقة جاية وعلم ينتفع به

السلام عليكم انظر الي هذا المرفق ابجده فور الكتابه.rar

السلام عليكم جميل جداً