اذهب الي المحتوي
أوفيسنا

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


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]_((#,##);_(--_);_(@_)"

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

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

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

رابط هذا التعليق
شارك

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

تحية طيبة ،،،،،

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

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

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

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

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

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

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

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

أخوكم

عيد مصطفى

رابط هذا التعليق
شارك

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

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

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

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

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

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

D5:P137

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

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

D5:AH141

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

رابط هذا التعليق
شارك

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

تحية طيبة ،،،،،

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

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

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

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

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

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

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

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

أخوك

عيد مصطفى

Mobile Bill Analysis (2012).rar

تم تعديل بواسطه 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

رابط هذا التعليق
شارك

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

تحية طيبة ،،،،،

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

:signthankspin::signthankspin:

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

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

أخوك

عيد مصطفى

رابط هذا التعليق
شارك

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

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

رابط هذا التعليق
شارك

  • 4 weeks later...

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

تحية طيبة ،،،،،

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

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

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

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

أخوك

عيد مصطفى

Horizontal & Vertical Alignment.rar

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

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

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

أخوك

عيد مصطفى

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information