تغيير تنسيق ومحاذاة الارقام بالكود

[Eid Mostafa]

_{الأخوة الأعزاء}

_{تحية طيبة ،،،،،}

_{بالملف المرفق يوجد كود كالتالى :-}

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

[عبدالله باقشير]

السلام عليكم

جرب هذا

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ce As Range

If Intersect(Target, Range("D5:P141")) Is Nothing Then Exit Sub

'''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

'''''''''''''''''''''''''''''''''''''''

If IsNumeric(Target) Then kh_Format Target

'''''''''''''''''''''''''''''''''''''''

For Each ce In Range("D5:AH141")

    If ce.HasFormula Then

        If IsNumeric(ce) Then kh_Format ce

    End If

Next

''''''''''''''''''''''''''''''''

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

'''''''''''''''''''''''''''''''

End Sub


Private Sub kh_Format(ByVal Cel As Range)

With Cel

    .NumberFormat = "_(#,##_);[Red]_((#,##);_(--_);_(@_)"

    .HorizontalAlignment = IIf(.Value, xlRight, xlCenter)

    .VerticalAlignment = xlCenter

End With

End Sub

[عبدالله باقشير]

بالنسبة لهذا السطر ما في داعي لتكراره

.NumberFormat = "_(#,##_);[Red]_((#,##);_(--_);_(@_)"

اعمل التنسيق هذا للرقم يدويا على جميع النطاق

رايي انا ان تحذفه من الكود

وهذا راجع اليك

[Eid Mostafa]

_{أستاذى الكبير / عبدالله باقشير}

_{تحية طيبة ،،،،،}

_{بداية أشكرك على حسن وسرعة تجاوبك}

_{ولكن أخى الكريم الكود لا يعمل فى الجزء (المدى) الثانى أى من R5 : AH141}

_{هذا الكود يقوم بعمل محاذاة بالوسط (Center Alignment) للقيم الصفرية أى إذا كانت القيمة بالخلية صفر أما إذا كانت تحتوى على قيمة سواء أكبر أو أصغر من الصفر فيقوم الكود بمحاذاتها باليمين.}

_{الإختلاف فقط بين الكودان هو أن الجزء (المدى) الأول من D5 : P141 هى كميات لذا لايجب وضع علامات عشرية لها}

_{أما الجزء (المدى) الثانى من R5 : AH141 فتوجد به قيم مادية لذا يجب وضع علامات عشرية لها لإيضاح فئات الجنية (القروش)}

_{فهل بالإمكان تفعيل الكودين فى النطاق المحدد لكل منهما} ولا يشترط دمج الكودان معاً.

_{أرجو أن أكون قد وفقت فى شرح ما أقصدة.}

_{خالص شكرى وتقديرى}

_أخوكم

_{عيد مصطفى}

[عبدالله باقشير]

وعليكم السلام

اريد ان اعرف كيف جربت الكود في النطاق R5:AH141

المدى هذا فيه معادلات !!!!!!!!!!!

------------------------------------

طريقة عمل الكود هي :

اذا غيرت اي قيمة في المدى

D5:P137

سيعمل الكود في خلية الادخال

و جميع المعادلات في المدى

D5:AH141

جرب واخبرنا بالنتيجة

[Eid Mostafa]

_{أستاذى الكبير / عبدالله باقشير}

_{تحية طيبة ،،،،،}

_{أخى الكريم أنا أعلم تماماً بأن النطاق R5:AH141 بة معادلات}

_{فالغرض من الكود لا يتعارض مع ما إذا كانت الخلية يتم بها إدخال أو ما إذا كان بها معادلة}

_{فالغرض من الكود يتمثل فى محاذاة القيم الصفرية بالوسط}

_{وإذا تم تطبيق الكود فى النطاقان " D5 : P141 " ثم " R5 : AH141 " فسيتم التغيير (المحاذاة) حيث أنه وبطريقة تلقائية عند إدخال الكميات بالنطاق الأول سيتأثر النطاق الأول ثم يلية النطاق الثانى فى التأثر أيضاَ.}

_{وحتى إن لم يحدث التأثر فيمكن الوقوف بأى خلية فى النطاق الثانى والضغط على زر F2 ثم الضغط على زر Enter لتفعيل عمل الكود والذى بدورة سيقوم بمحاذاة كافة القيم الصفرية.}

_{مرفق ملف مطبق بة الكود فى مدى به معادلات فقط قم بالوقوف بالخلية L5 وطبق ما ذكرتة بأعلاة F2 ثم Enter ستجد أن الكود يقوم بتفعيل المطلوب منه (المحاذاة) حتى وإن كانت الخلية تحتوى على معادلة.}

_{أرجو أن أكون قد وفقت فى شرح ما أقصدة.}

_{خالص شكرى وتقديرى}

_أخوك

_{عيد مصطفى}

Mobile Bill Analysis (2012).rar

تم تعديل أكتوبر 2, 2012 بواسطه Eid Mostafa

[عبدالله باقشير]

السلام عليكم

هناك لبس في فهم الطلب

ولم الاحظ اختلاف فورمات الارقام بين الكودين

عذرا

هذا التعديل حسب طلبك

ان شاء الله

Private Sub Worksheet_Change(ByVal Target As Range)

Dim ce As Range

If Intersect(Target, Range("D5:P141")) Is Nothing Then Exit Sub

'''''''''''''''''''''''''''''''''''''''

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

'''''''''''''''''''''''''''''''''''''''

For Each ce In Range("D5:AH141")

If Not IsNumeric(ce) Then GoTo 1

With ce

If Not Intersect(ce, Range("D5:P141")) Is Nothing Then

.NumberFormat = "_(#,##_);[Red]_((#,##);_(--_);_(@_)"

Else

.NumberFormat = "_(#,##0.00_);[Red]_((#,##0.00);_(--_);_(@_)"

End If

.HorizontalAlignment = IIf(.Value, xlRight, xlCenter)

.VerticalAlignment = xlCenter

End With

1:

Next

''''''''''''''''''''''''''''''''

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

'''''''''''''''''''''''''''''''

End Sub

[Eid Mostafa]

_{أستاذى الكبير / عبدالله باقشير}

_{تحية طيبة ،،،،،}

_{أخى الكريم سلمت يداك بالفعل هذا هو المطلوب تماماً}

_{والعذر أيضاً من جانبى إن جانبنى الصواب فى إيضاح الأمر بدرجة كافية.}

_{خالص شكرى وتقديرى}

_أخوك

_{عيد مصطفى}

[يوسف عطا]

سلمت يداك خبور بك خير

الرجاء من أحد الأفاضل المشرفين تعديل العنوان ليتناسب مع محتوى الموضوع بتسمية الكود المطلوب إضافته

[Eid Mostafa]

_{أستاذى الكبير / عبدالله باقشير}

_{تحية طيبة ،،،،،}

_{أخى الكريم أرجو منك التكرم بإجراء تعديل (طفيف) بالنسبة لك ولكنه (كبير جداً) بالنسبة لى وذلك بكود تغيير تنسيق ومحاذاة الأرقام}

_{حيث لاحظت أنه فى حالة (دمج الخلايا)} (Merge Cell) _{فالكود لا يعمل بالشكل المطلوب منه ، حيث يقوم بمحاذاة القيم الصفرية والغير صفرية (بالمنتصف).}

_{مثال ذلك (الخلية E133) حيث ستجد أن الكود قد قام بمحاذاة القيمة (1) بالمنتصف رغم أنه كان ينبغى أن يقوم بمحاذاتها باليمين.}

_{خالص شكرى وتقديرى}

_أخوك

_{عيد مصطفى}

Horizontal & Vertical Alignment.rar

[Eid Mostafa]

_{للرفـــــــــع}

تم تعديل أكتوبر 30, 2012 بواسطه Eid Mostafa

[Eid Mostafa]

_{أستاذنا الكبير / عبدالله باقشير}

_{تحية طيبة ،،،،،}

_للرفع

_{رفع الله قدرك}

_{خالص شكرى وتقديرى}

_أخوك

_{عيد مصطفى}

[عبدالله باقشير]

السلام عليكم

الدمج يسبب تعارض مع الاكواد والمعادلات في كثير من الاحوال

الحل بيدك اخي الفاضل

بازالة الدمج لتنتهي المشكلة

تقبل تحياتي وشكري

[Eid Mostafa]

_{أستاذنا الكبير / عبد الله باقشير}

============

_{السلام عليكم ورحمة الله وبركاتة}

_{أشكرك على إهتمامك بالرد}

_{وكما ذكرت سأحاول أن أبحث عن سبل أخرى لتلافى دمج الخلايا}

============

_{خالص شكرى وتقديرى}

_أخوك

_{عيد مصطفى}