الأخوة الأعزاء
تحية طيبة ،،،،،
بالملف المرفق يوجد كود كالتالى :-
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