Eid Mostafa قام بنشر أكتوبر 2, 2012 مشاركة قام بنشر أكتوبر 2, 2012 الأخوة الأعزاء تحية طيبة ،،،،، بالملف المرفق يوجد كود كالتالى :- 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 رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أكتوبر 2, 2012 مشاركة قام بنشر أكتوبر 2, 2012 السلام عليكم جرب هذا 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 رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أكتوبر 2, 2012 مشاركة قام بنشر أكتوبر 2, 2012 بالنسبة لهذا السطر ما في داعي لتكراره .NumberFormat = "_(#,##_);[Red]_((#,##);_(--_);_(@_)" اعمل التنسيق هذا للرقم يدويا على جميع النطاق رايي انا ان تحذفه من الكود وهذا راجع اليك رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر أكتوبر 2, 2012 الكاتب مشاركة قام بنشر أكتوبر 2, 2012 أستاذى الكبير / عبدالله باقشير تحية طيبة ،،،،، بداية أشكرك على حسن وسرعة تجاوبك ولكن أخى الكريم الكود لا يعمل فى الجزء (المدى) الثانى أى من R5 : AH141 هذا الكود يقوم بعمل محاذاة بالوسط (Center Alignment) للقيم الصفرية أى إذا كانت القيمة بالخلية صفر أما إذا كانت تحتوى على قيمة سواء أكبر أو أصغر من الصفر فيقوم الكود بمحاذاتها باليمين. الإختلاف فقط بين الكودان هو أن الجزء (المدى) الأول من D5 : P141 هى كميات لذا لايجب وضع علامات عشرية لها أما الجزء (المدى) الثانى من R5 : AH141 فتوجد به قيم مادية لذا يجب وضع علامات عشرية لها لإيضاح فئات الجنية (القروش) فهل بالإمكان تفعيل الكودين فى النطاق المحدد لكل منهما ولا يشترط دمج الكودان معاً. أرجو أن أكون قد وفقت فى شرح ما أقصدة. خالص شكرى وتقديرى أخوكم عيد مصطفى رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أكتوبر 2, 2012 مشاركة قام بنشر أكتوبر 2, 2012 وعليكم السلام اريد ان اعرف كيف جربت الكود في النطاق R5:AH141 المدى هذا فيه معادلات !!!!!!!!!!! ------------------------------------ طريقة عمل الكود هي : اذا غيرت اي قيمة في المدى D5:P137 سيعمل الكود في خلية الادخال و جميع المعادلات في المدى D5:AH141 جرب واخبرنا بالنتيجة رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر أكتوبر 2, 2012 الكاتب مشاركة قام بنشر أكتوبر 2, 2012 (معدل) أستاذى الكبير / عبدالله باقشير تحية طيبة ،،،،، أخى الكريم أنا أعلم تماماً بأن النطاق R5:AH141 بة معادلات فالغرض من الكود لا يتعارض مع ما إذا كانت الخلية يتم بها إدخال أو ما إذا كان بها معادلة فالغرض من الكود يتمثل فى محاذاة القيم الصفرية بالوسط وإذا تم تطبيق الكود فى النطاقان " D5 : P141 " ثم " R5 : AH141 " فسيتم التغيير (المحاذاة) حيث أنه وبطريقة تلقائية عند إدخال الكميات بالنطاق الأول سيتأثر النطاق الأول ثم يلية النطاق الثانى فى التأثر أيضاَ. وحتى إن لم يحدث التأثر فيمكن الوقوف بأى خلية فى النطاق الثانى والضغط على زر F2 ثم الضغط على زر Enter لتفعيل عمل الكود والذى بدورة سيقوم بمحاذاة كافة القيم الصفرية. مرفق ملف مطبق بة الكود فى مدى به معادلات فقط قم بالوقوف بالخلية L5 وطبق ما ذكرتة بأعلاة F2 ثم Enter ستجد أن الكود يقوم بتفعيل المطلوب منه (المحاذاة) حتى وإن كانت الخلية تحتوى على معادلة. أرجو أن أكون قد وفقت فى شرح ما أقصدة. خالص شكرى وتقديرى أخوك عيد مصطفى Mobile Bill Analysis (2012).rar تم تعديل أكتوبر 2, 2012 بواسطه Eid Mostafa رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أكتوبر 3, 2012 مشاركة قام بنشر أكتوبر 3, 2012 السلام عليكم هناك لبس في فهم الطلب ولم الاحظ اختلاف فورمات الارقام بين الكودين عذرا هذا التعديل حسب طلبك ان شاء الله 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 رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر أكتوبر 3, 2012 الكاتب مشاركة قام بنشر أكتوبر 3, 2012 أستاذى الكبير / عبدالله باقشير تحية طيبة ،،،،، أخى الكريم سلمت يداك بالفعل هذا هو المطلوب تماماً والعذر أيضاً من جانبى إن جانبنى الصواب فى إيضاح الأمر بدرجة كافية. خالص شكرى وتقديرى أخوك عيد مصطفى رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر أكتوبر 3, 2012 مشاركة قام بنشر أكتوبر 3, 2012 سلمت يداك خبور بك خير الرجاء من أحد الأفاضل المشرفين تعديل العنوان ليتناسب مع محتوى الموضوع بتسمية الكود المطلوب إضافته رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر أكتوبر 28, 2012 الكاتب مشاركة قام بنشر أكتوبر 28, 2012 أستاذى الكبير / عبدالله باقشير تحية طيبة ،،،،، أخى الكريم أرجو منك التكرم بإجراء تعديل (طفيف) بالنسبة لك ولكنه (كبير جداً) بالنسبة لى وذلك بكود تغيير تنسيق ومحاذاة الأرقام حيث لاحظت أنه فى حالة (دمج الخلايا) (Merge Cell) فالكود لا يعمل بالشكل المطلوب منه ، حيث يقوم بمحاذاة القيم الصفرية والغير صفرية (بالمنتصف). مثال ذلك (الخلية E133) حيث ستجد أن الكود قد قام بمحاذاة القيمة (1) بالمنتصف رغم أنه كان ينبغى أن يقوم بمحاذاتها باليمين. خالص شكرى وتقديرى أخوك عيد مصطفى Horizontal & Vertical Alignment.rar رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر أكتوبر 30, 2012 الكاتب مشاركة قام بنشر أكتوبر 30, 2012 (معدل) للرفـــــــــع تم تعديل أكتوبر 30, 2012 بواسطه Eid Mostafa رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر نوفمبر 3, 2012 الكاتب مشاركة قام بنشر نوفمبر 3, 2012 أستاذنا الكبير / عبدالله باقشير تحية طيبة ،،،،، للرفع رفع الله قدرك خالص شكرى وتقديرى أخوك عيد مصطفى رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر نوفمبر 3, 2012 مشاركة قام بنشر نوفمبر 3, 2012 السلام عليكم الدمج يسبب تعارض مع الاكواد والمعادلات في كثير من الاحوال الحل بيدك اخي الفاضل بازالة الدمج لتنتهي المشكلة تقبل تحياتي وشكري رابط هذا التعليق شارك More sharing options...
Eid Mostafa قام بنشر نوفمبر 5, 2012 الكاتب مشاركة قام بنشر نوفمبر 5, 2012 أستاذنا الكبير / عبد الله باقشير ============ السلام عليكم ورحمة الله وبركاتة أشكرك على إهتمامك بالرد وكما ذكرت سأحاول أن أبحث عن سبل أخرى لتلافى دمج الخلايا ============ خالص شكرى وتقديرى أخوك عيد مصطفى رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان