البحث في الموقع
Showing results for tags 'هــــــام'.
تم العثور علي 1 نتيجه
-
الأخوة الأعزاء تحية طيبة ،،،،، بالملف المرفق يوجد كود كالتالى :- Private Sub Worksheet_Change(ByVal Target As Range) Dim myRange As Range Set myRange = [D5:P141] If Intersect(Target, myRange) Is Nothing Then Exit Sub Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In myRange If IsNumeric(ce) = False Then GoTo 1 ce.NumberFormat = "_(#,##_);[Red]_((#,##);_(--_);_(@_)" If ce.Value = 0 Then With ce .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub وكما يظهر لكم فهو مطبق على النطاق من " D5 : P141 " حاولت إضافة هذا الكود إلية كالتالى :- Private Sub Worksheet_Change(ByVal Target As Range) Dim myRange As Range Set myRange = [R5:AH141] If Intersect(Target, myRange) Is Nothing Then Exit Sub Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In myRange If IsNumeric(ce) = False Then GoTo 1 ce.NumberFormat = "_(#,##0.00_);[Red]_((#,##0.00);_(--_);_(@_)" If ce.Value = 0 Then With ce .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub لكى يتم تطبيقة فى النطاق من " R5 : AH141 " ولكنى لم أفلح فى ذلك .. !! فهل بإمكانكم التكرم وإضافة الكود الثانى للملف وبحيث يعمل كلا الكودين فى النطاق المحدد لكل منهما. أرجو أن أكون قد وفقت فى شرح ما أقصدة. خالص شكرى وتقديرى أخوكم عيد مصطفى Merging 2 Codes.rar
