Eid Mostafa قام بنشر فبراير 2, 2012 قام بنشر فبراير 2, 2012 الأخوة الأعزاء السلام عليكم ورحمة الله وبركاته هل بالإمكان عمل كود يقوم بعمل محاذاة بالمنتصف (Align Center) وذلك للقيم الصفرية فقط وفى كافة نطاق الملف وسواء كانت ناتجة عن عملية إدخال يدوى أو ناتجة عن معادلة ؟ فى إنتظار إفاداتكم القيمة أخوكم عيد مصطفى Breakdown - 2011.rar
طارق محمود قام بنشر فبراير 3, 2012 قام بنشر فبراير 3, 2012 السلام عليكم أخي الحبيب / عيد جرب الكود التالي في حدث الورقة Private Sub Worksheet_Activate() For Each ce In UsedRange If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End If Next ce End Sub Private Sub Worksheet_Change(ByVal Target As Range) For Each ce In UsedRange If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With End If Next ce End Sub
Eid Mostafa قام بنشر فبراير 3, 2012 الكاتب قام بنشر فبراير 3, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته أشكرك قبل أى شيء على إهتمامك والآن إليك ما حدث بالفعل قام الكود بعمل محاذاة بالمنتصف للقيمة بعدما أصبحت صفراً ولكن وفى حالة إعادة إدخال قيمة أخرى ينتج عنها تعديل رصيد آخر العام وبالتالى لم يعد صفراً وأصبحت هنالك قيمة بقيت المحاذاة بالمنتصف فهل الكود ينقصه شيئاً ما لإرجاع المحاذاة إلى اليمين فى حال ما تغيرت القيمة مرة أخرى وسواء أصبحت القيمة أكبر أو أصغر من الصفر فى إنتظار إفاداتك القيمة أخوك عيد مصطفى
طارق محمود قام بنشر فبراير 4, 2012 قام بنشر فبراير 4, 2012 السلام عليكم علي عجالة جرب أخي هذا التغيير Private Sub Worksheet_Activate() For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom End With End If 1 Next ce End Sub Private Sub Worksheet_Change(ByVal Target As Range) For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((###### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlBottom End With End If 1 Next ce لم أجد وقتا لتجريبه أخبرني النتيجة
Eid Mostafa قام بنشر فبراير 4, 2012 الكاتب قام بنشر فبراير 4, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته الله ينور عليك طبعاً ولتسمح لى فقد قمت بعمل التعديل التالى على الكود :- Private Sub Worksheet_Activate() For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((### ### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With End If 1 Next ce End Sub Private Sub Worksheet_Change(ByVal Target As Range) For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((### ### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With End If 1 Next ce End Sub حيث أن الكود وفقاً لما أرسلته إلى قد قام بعمل محاذاه رأسيه (أسفل) وليس بالمنتصف وذلك لأرقام سطر 14 ولا أعلم لماذا ولكن بعد تعديل الكود إلى ما هو بأعلاه تم حل تلك المشكله (منكم نستفيد طبعاً) والآن وإن كان لديك ما يسمح من الوقت فقد بقيت مشكله شكليه بسيطه ولم أستطع حلها ألا وهى إن دققت النظر فى G10 ، G11 ستجد أن هنالك عدم تماثل فى المحاذاه وقد حاولت أن أحلها ولكن لم أفلح فى ذلك وأنا أريد إتباع نمط محاذاة ماهو فى G11 مرة أخرى ما وصلنا إليه هو أمر فوق الرائع ولكن إن أمكننا حل تلك النقطه الأخيره سيكون الأمر أروع و أروع لك خالص شكرى وتقديرى أخوك عيد مصطفى Breakdown - 2011.rar
طارق محمود قام بنشر فبراير 5, 2012 قام بنشر فبراير 5, 2012 السلام عليكم أضفت لك سطر ترحيل هامش الخلية بمقدار 1 كما في G11 وهو هذا السطر لكلا الكودين .IndentLevel = 1 وكذلك اضفت سطرين في أول الكود لإيقاف عمليات الحساب وتغير الشاشة مع استرجاعهما في آخر الكود بغرض تسريع النتائج (حيث كانت بطيئة نسبيا وهما هذان في أول الكود Application.ScreenUpdating = False Application.Calculation = xlCalculationManual وهذان في آخره Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic جرب الكود الآن كاملا كالتالي Private Sub Worksheet_Activate() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((### ### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .IndentLevel = 1 .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In UsedRange If IsNumeric(ce) = False Then GoTo 1 If ce.Value = 0 Then With ce .NumberFormat = "_(### ### ###_);[Red]_((### ### ###);_(--_);_(@_)" .HorizontalAlignment = xlCenter .IndentLevel = 1 .VerticalAlignment = xlCenter End With Else With ce .HorizontalAlignment = xlRight .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
Eid Mostafa قام بنشر فبراير 5, 2012 الكاتب قام بنشر فبراير 5, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته الله ينور عليك طبعاً بالفعل الملف أصبح أسرع وبالفعل أتى هامش الخلية بمقدار 1 أو (IndentLevel = 1) بثماره ولكن الصفر أو القيم الصفريه أصبحت محاذيه لليسار ، وليست بالوسط فهل لك التكرم بإرجاعها إلى الوسط مع الإبقاء على ما توصلنا إليه من سرعه وأداء أسرع ؟؟؟؟ خالص شكرى وتقديرى أخوك عيد مصطفى Breakdown - 2011.rar
طارق محمود قام بنشر فبراير 5, 2012 قام بنشر فبراير 5, 2012 السلام عليكم أخي عيد إحذف سطر .IndentLevel = 1 من جزئية الصفر ليصبح الكود كالتالي Private Sub Worksheet_Activate() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In UsedRange 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 .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For Each ce In UsedRange 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 .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
Eid Mostafa قام بنشر فبراير 5, 2012 الكاتب قام بنشر فبراير 5, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته أحسنت والله ينور عليك طبعاً كده كله تمام التمام ، لا أملك إلا أن أقول بالفعل أنت عبقرى أنت وصلت للمطلوب ولكن أكيد تعبتك معايا كتير أنا متعب دائماً فى طلباتى لك خالص شكرى وتقديرى أخوك عيد مصطفى
Eid Mostafa قام بنشر فبراير 5, 2012 الكاتب قام بنشر فبراير 5, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته العذر كل العذر مرة أخرى هل يمكن تطبيق الكود على نطاق محدد ؟؟؟ وذلك لتفادى أمر ما لا زلت أفكر به بمعنى أنى أريد تطبيقه فقط على النطاق (المدى) التالى C7 إلى I14 ، فكيف أعدل بالكود ؟ لك خالص شكرى وتقديرى أخوك عيد مصطفى
طارق محمود قام بنشر فبراير 6, 2012 قام بنشر فبراير 6, 2012 السلام عليكم أخي الحبيب لاتنزعج أبدا من الأسئلة فهذه أسلم الطرق لحفر المعلومة في الرأس ردا علي سؤالك في الحقيقة الكود الأول ليس له داعي يلزمك إضافة السطورالتالية في أول الكود Dim myRange As Range Set myRange = [C7:I14] If Intersect(Target, myRange) Is Nothing Then Exit Sub وكذلك تغيير السطر For Each ce In UsedRange إلي For Each ce In myRange يعني سيكون الكود كالتالي Private Sub Worksheet_Change(ByVal Target As Range) Dim myRange As Range Set myRange = [C7:I14] 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 .IndentLevel = 1 .VerticalAlignment = xlCenter End With End If 1 Next ce Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
Eid Mostafa قام بنشر فبراير 6, 2012 الكاتب قام بنشر فبراير 6, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته لقد جربت الكود بعد التعديل وأتى بثماره تماماً بالفعل لك كل التقدير والإحترام أنا فقط أخشى أن أثقل عليك بطلباتى من ناحية ومن ناحية أخرى فالموضوع يبداً بفكره ثم يتطور وتليها أفكار و أفكار ما يستدعى السؤال ثم السؤال مرات ومرات وهذا ما يشعرنى بالإحراج أحياناً كثيره ولكنك دائماً تبدد لى هذا الإحراج لك خالص شكرى وتقديرى أخوك عيد مصطفى
Eid Mostafa قام بنشر فبراير 14, 2012 الكاتب قام بنشر فبراير 14, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته ممكن معلش تكمل جميلك وتفيدنى عن ما إذا بالإمكان عمل نطاقان مختلفان للتطبيق بمعنى نحن الآن وصلنا إلى Set myRange = [C7:I14] فهل يمكن على سبيل المثال إضافة نطاق آخر إلى الكود وليكن Set myRange = [Q9:V20] على سبيل المثال فهل هذا جائز ؟؟؟؟؟ لك خالص شكرى وتقديرى أخوك عيد مصطفى
طارق محمود قام بنشر فبراير 14, 2012 قام بنشر فبراير 14, 2012 السلام عليكم نعم أخي يوجد دالة جميلة إسمها Union تستطيع عمل مثلا Set myRange = Union([C7:I14], [Q9:V20])
Eid Mostafa قام بنشر فبراير 14, 2012 الكاتب قام بنشر فبراير 14, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته أشكرك مقدماً قبل تجربة الكود علماً بأنى كلى ثقه فى كل ما يأتينى منك وإعذرنى فلى طلب أخر منك أرجو منك الإطلاع على تلك المشاركه http://www.officena.net/ib/index.php?showtopic=40757 لك خالص شكرى وتقديرى أخوك عيد مصطفى
Eid Mostafa قام بنشر فبراير 14, 2012 الكاتب قام بنشر فبراير 14, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته بعد التجربه تمام التمام الله ينور بارك الله فيك وطبعاً زى مانت عارف مش هعدى الموضوع بالساهل كده ولازم أسأل أكتر هل هذة الداله لها حد أقصى ؟؟؟؟؟ وكم هو ذلك الحد ؟؟؟؟؟؟ بمعنى هل يمكننى عمل ما يلى على سبيل المثال :- Set myRange = Union([C7:I14], [Q9:V20], [X90:Y120], [AB15:BC18]) لك خالص شكرى وتقديرى أخوك عيد مصطفى
طارق محمود قام بنشر فبراير 15, 2012 قام بنشر فبراير 15, 2012 السلام عليكم لاأعتقد أن لها حد أقصي ولو أني لاأفضل ان يزيد عدد حروف المعادلة (بما فيها من دوال) عن 255 حرف (كنت قد قرات مرة أن هذا يؤدي لمشاكل) إن شرحت لي ماتريد بالضبط ، فقد يكون هناك حلول أفضل مثلا أنظر الفيديو المرفق إخترت أماكن ليس لها علاقة ببعض وليست بنفس النسق المهم تكون مستمر بالضغط علي زر الـ Ctrl ثم تسمي هذا الخليط من النطاقات ماشئت وتطلب من الكود ان يتعامل مع هذا المسمي في الفيديو ، سميت النطاقات المختلفة (مجتمعة) EID Rang_Name.rar
طارق محمود قام بنشر فبراير 15, 2012 قام بنشر فبراير 15, 2012 بالنسبة لمشاركتك #16 ذهبت للموضوع فرأيت اخونا بن عليه قد أفادك فيه
Eid Mostafa قام بنشر فبراير 15, 2012 الكاتب قام بنشر فبراير 15, 2012 أخى العزيز / طارق السلام عليكم ورحمة الله وبركاته والله يا سيدى القلوب عند بعضها طبعاً وقبل أى شئ أشكرك على إهتمامك الدائم وبالتجربه أضفت نطاقات ليست لها علاقه ببعضها إطلاقاً ونجحت التجربه فإنظر إلى ذلك السطر :- Set myRange = Union([b4:C120], [F4:P120], [R4:S120], [b128:C146], [F128:P146], [R128:S146]) أضفته إلى أحد الشيتات ونجح لك خالص شكرى وتقديرى أخوك عيد مصطفى
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.