محمد الورفلي1 قام بنشر أكتوبر 25, 2014 مشاركة قام بنشر أكتوبر 25, 2014 اريد جمع هذان الكودين 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 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 25, 2014 مشاركة قام بنشر أكتوبر 25, 2014 (معدل) جرب التالي .. قم بالتجربة لأني لم أجربه Private Sub ShockwaveFlash1_OnReadyStateChange(ByVal newState As Long) End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Dim rg As Range ActiveSheet.Unprotect "" If Not Intersect(Target, Range("h10")) Is Nothing Then 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 If 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 On Error Resume Next Select Case Target Case "ك" Target = "ذكر" Case "ن" Target = "انثى" End Select End If 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: ActiveSheet.Protect "" Application.ScreenUpdating = True End Sub تم تعديل أكتوبر 25, 2014 بواسطه YasserKhalil رابط هذا التعليق شارك More sharing options...
محمد الورفلي1 قام بنشر أكتوبر 25, 2014 الكاتب مشاركة قام بنشر أكتوبر 25, 2014 الاخ ياسر ظهرت لي هذه الرسالة رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 25, 2014 مشاركة قام بنشر أكتوبر 25, 2014 أخي الحبيب إذا كنت تنوي التعامل مع الأكواد فقم بإلغاء دمج الخلايا واستبدل هذا الدمج بالتوسيط خلال مجموعو خلايا عن طريق تحديد مجموعة الخلايا التي تريد توسيط النص بها ثم كليك يمين وتنسيق خلايا ثم التبويب Alignment ثم من القائمة المنسدلة الأولى اختر Center Across Seelction. رابط هذا التعليق شارك More sharing options...
محمد الورفلي1 قام بنشر أكتوبر 25, 2014 الكاتب مشاركة قام بنشر أكتوبر 25, 2014 شكراً اخي يلسر رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 25, 2014 مشاركة قام بنشر أكتوبر 25, 2014 شكراً اخي يلسر عفوا يا خلزمي رابط هذا التعليق شارك More sharing options...
محمد الورفلي1 قام بنشر أكتوبر 25, 2014 الكاتب مشاركة قام بنشر أكتوبر 25, 2014 (معدل) اسف على الخطاء في كتابة اسمك فقط من الاستعجال اخي ياسر بعد اذنك فقط جربت فك دمج الخلاياء بدون فائدة نفس الرسالة ممكن تجربة وتصلح لي الخطاء لو سمحت تم تعديل أكتوبر 25, 2014 بواسطه محمد الخازمي رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.