محمد طاهر

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

جرب الكود التالي ، اعتقد انه يمكن اختصاره بعض الشيء ، و لكن اتصور انه يؤدي المطلوب اولا ظلل الخلايا المطلوب تحليلها ثم شغل الكود و قم باختباره ملاحظة بعد النشر : وضعت الوان مختلفة حيث لم انتبه للون الاصفر و ووضعت بدلا منه اخضر ، يمكنك تعديله كما تشاء علما بان كود اللون الاصفر 65535 Sub Color_Dubplicatesl() ' color duplicates hzl adn vl as requested by youssef Atta on 14 june Dim myrow, mycol As Integer mycol = Selection.Columns.Count myrow = Selection.Rows.Count Selection.Interior.ColorIndex = xlNone '================= ' Hzl Dubplicate For i = 0 To myrow - 1 For j = 0 To mycol - 1 If Not IsNull(ActiveCell.Offset(i, j).Value) And ActiveCell.Offset(i, j).Value <> "" Then If IsNumeric(ActiveCell.Offset(i, j).Value) Then For k = j + 1 To mycol - 1 ' compare this col If ActiveCell.Offset(i, j).Value = ActiveCell.Offset(i, k).Value Then ActiveCell.Offset(i, j).Cells.Interior.Color = 255 ' red ActiveCell.Offset(i, k).Cells.Interior.Color = 255 ' red Exit For End If Next k ' compare this col End If ' if numeric End If ' not if null Next j Next i '============== ' Vl Duplicates '================= For i = 0 To mycol - 1 For j = 0 To myrow - 1 If Not IsNull(ActiveCell.Offset(j, i).Value) And ActiveCell.Offset(j, i).Value <> "" Then If IsNumeric(ActiveCell.Offset(j, i).Value) Then For k = j + 1 To myrow - 1 ' compare this col If ActiveCell.Offset(j, i).Value = ActiveCell.Offset(k, i).Value Then If ActiveCell.Offset(j, i).Cells.Interior.Color = 255 Then ActiveCell.Offset(j, i).Cells.Interior.Color = 5287936 ' green Else ActiveCell.Offset(j, i).Cells.Interior.Color = 15773696 ' cyan End If If ActiveCell.Offset(k, i).Cells.Interior.Color = 255 Then ActiveCell.Offset(k, i).Cells.Interior.Color = 5287936 ' green Else ActiveCell.Offset(k, i).Cells.Interior.Color = 15773696 ' cyan End If Exit For End If Next k ' compare this col End If ' if numeric End If ' not if null Next j Next i End Sub ساقية.xls

و ماذا اذا حدث تكرار رأسيا و افقيا لنفس الرقم ، افترض ان الشرط الثاني سيجب الاول اي ستكون الخلية رزفاء ، هل هذا صحيح؟

ملخص عن كتاب: الجدول في إعراب القرآن

أتصور أن الملف المرفق في المشاركة الأولى في هذا الموضوع يقوم بذلك .تعطيه المتوسط فتحصلين على الناتج وفق مقياس ليكارد الخماسي

غابا يجتاج الباحث الي تعديل تنسيق ما ذكر بين الأقواس ليجعله بخط مائل و للتطبيق على كافة محتويات الملف دفعة واحدة و ليست المنطقة المختارة فقط Sub FormatBetBracketsWholeDoc() Dim cDoc As Word.Document Dim cRng As Word.Range Set cDoc = ActiveDocument Set cRng = cDoc.Content cRng.Find.ClearFormatting With cRng.Find .Forward = True .Text = "(" .Wrap = wdFindStop .Execute Do While .Found cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd cRng.MoveEndUntil Cset:=")", Count:=Word.wdForward cRng.FormattedText.Italic = True cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd .Execute Loop End With End Sub و يمكن ايضا عمل ذلك بعدة طرق بديلة كما هو فى الموضوع الأصلي

و هنا تعديل التنسيق فقط بجعل الحروف بين الأقواس مائلة تبعا لبعض متطليات كتابة الابحاث العلمية Sub FormatBetBrackets() 'Set What is between Parenthesis Italic in a slected range 'لاستبدال تنسيق ما بين الأقواس و جعله مائل فى مجال مختار Dim cDoc As Word.Document Dim cRng As Word.Range Set cDoc = ActiveDocument Set cRng = Selection.Range cRng.Find.ClearFormatting With cRng.Find .Forward = True .Text = "(" .Wrap = wdFindStop .Execute Do While .Found cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd cRng.MoveEndUntil Cset:=")", Count:=Word.wdForward cRng.FormattedText.Italic = True cRng.Collapse Word.WdCollapseDirection.wdCollapseEnd .Execute Loop End With End Sub

موضوع مخالف تم الاغلاق لا يسمح بفك جماية الملفات التى اضاف اصحابها لها حماية و فى نفس الوقت نشجع الجميع على نشر الملفات بدون جماية لتحقيق الاستفادة العامة

الحل الأول : الاول اختيار النص المطلوب تحديث الاشارات به ،و ليكن صفحة او فصل او فقرة او حتى المستند ككل من خلال Ctr+A و ان كان ذلك قد يكون اجراء بطيئ فى حال المستندات الكبيرة ، ثم اضغط F9 فيتم تحديث الحقول ( الاشارة ضمن سياق الكلام) فى النطاق المختار دفعة واحدة الحل الثاني : و هو هام جدا ايضا ، و هو التأكد من التحديث قبل الطباعة و هذا من خلال File Options Display Printing Options Update Fields before printing و هذا الخيار غير مفعل بصورة نمطية و يجب تفعيله بصورة يدوية

عند اضافة جدو ل أو رسم فى بحث علمي او مستند احترافي يتم استخدم الامر التالي references Insert Caption فيأخذ الجدول الترقيم الالي من ناحية و يتعرف المستند عليه ككائن مميز كجدول Table أو كرسم توضيحي (شكل) Figure و من ناحية اخرى نتمكن لاحقا من اعداد قائمة آلية بالجداول و الأشكل و ذلك من References insert Table or figure و عند الاشارة الى الجدول او الرسم التوضيحي ضمن سياق الكتابة نستخدم Cross Reference captions مثال : التحديث: بالنسبة لقائمة المراجع و الرسومات التوضيحية يمكن تحديثها بصورة آلية دفعة واحدة باختيار الحدول ثم Update Field Update Entire Table ولكن المشكلة تكمن فى تحديث الاشارات المرجعية ضمن سياق الكتابة اذا لا يمكن تحديثها كلها دفعة واحدة ، و يجب اختيارها واحدة واحدة ثم اختيار Update Field و هذا طبعا اجراء مرهق فى حالة المستندات الكبيرة التي تجوى الكثر من الاشارات جداول و رسومات او عناوين فرعية ايضا لذا هناك حلان كما سيلي فى الرد التالي على الموضع

كل عام و انتم بخير 😃

هذه بعض المواضيع السابقة فى هذا الشأن كودتفقيط وورد كيفية إضافة كود التفقيط المرفق ليصبح صالحاً للإستخدام في ملف وورد 2007 أرجو مساعدتي في انشاء كود رجو المساعدة عمل ماكروتفقيط هل يمكن عمل كودتفقيطفى الوورد كما فى الاكسيل تفقيطالارقام فى الوورد تفقيطسلس وسريع في وورد دالة التفقيط العربي الصحيحة https://www.officena.net/team/mas/tafkeet/

و الكود التالي يتخص فقط باستبدال النسب ، اي الارقام او العبارات التي تنتهي ب علامة % فيقوم باضافة افواس لها Sub AddParens2NumbersP() ' يختص باضافة اقواس للعبارات المنتهية بعلامة % If Len(Selection.Range) > 0 Then For i = 1 To Selection.Words.Count With Selection.Words(i) If Right(Trim(.Text), 1) = "%" Then Selection.Words(i - 1).Text = "(" & Selection.Words(i - 1) .Text = Trim(.Text) & ") " i = i + 1 End If End With Next i Else MsgBox "لم تقم باختيار نطاق التطبيق" End If End Sub

و قد اضفت التطوير التالي للكود ليتيح اضافة اقواس لكافة الارقام الموجودة فى المنطقة المختارة اختار المنطقة أولا يم شغل الكود فيتم اضافة اقواس لكاقة الارقام ضمن المنطقة المظللة (المختارة) Sub AddParens2Numbers() If Len(Selection.Range) > 0 Then For i = 1 To Selection.Words.Count With Selection.Words(i) If IsNumeric(.Text) Then .Text = "(" & Trim(.Text) & ") " i = i + 1 End If End With Next i Else MsgBox "لم تقم باختيار العبارات المطلوب التعديل عليها " End If End Sub

كل عام و انتم بخير جميعاً