أبو عاصم المصري قام بنشر أغسطس 17, 2021 مشاركة قام بنشر أغسطس 17, 2021 احتجت إلى عمل ماكرو يحدد الأرقام المتوالية بشكل خاطئ، بحيث يأتي مثلا (151) بعد (150)، أو يتكرر رقم (151) لكن بشرط أن يكون بين الرقمين فاصلة (،) وهذا يحدث كثيرا في الفهارس، فعملت هذا الماكرو ليقوم بتظليل أي رقم وقع في موضع الخطأ، حسب المثال المذكور. وهذا الماكرو لمن أراد: Sub خطأترقيم() ' ' خطأترقيم Macro 'ماكرو يقوم بتتبع كل رقمين متتاليين، فإذا كان هناك رقمان تاليهما أكبر من السابق أو يساويه ظلله بالأصفر ' Selection.WholeStory Selection.Font.Color = wdColorAutomatic Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Replacement.ClearFormatting Selection.Find.Replacement.Font.Color = wdColorRed With Selection.Find .Text = "^#^#/" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll With Selection.Find .Text = "^#/" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute replace:=wdReplaceAll For i = 1 To 100000 Dim aa, b, c As Integer Selection.Find.ClearFormatting Selection.Find.Font.Color = wdColorAutomatic Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[0???-9]، [0???-9]" .Replacement.Text = "" .Forward = True .Wrap = wdFindStop .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.Execute If Selection.Find.Found = False Then End Else Selection.MoveLeft Unit:=wdWord, Count:=1 Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend aa = Val(Selection.Text) Selection.MoveRight Unit:=wdWord, Count:=2 Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend b = Val(Selection.Text) - 1 Selection.MoveLeft Unit:=wdWord, Count:=1 If aa > b Then Selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend Options.DefaultHighlightColorIndex = wdYellow Selection.Range.HighlightColorIndex = wdYellow Selection.MoveRight Unit:=wdWord, Count:=1 End If End If Next i If Selection.Find.Found = False Then MsgBox ("تم تحديد الأرقام المتتالية بالخطأ") End If Selection.HomeKey Unit:=wdStory MsgBox ("تم تحديد الأرقام المتتالية بالخطأ") End Sub 3 رابط هذا التعليق شارك More sharing options...
أ / محمد صالح قام بنشر أغسطس 17, 2021 مشاركة قام بنشر أغسطس 17, 2021 بارك الله لك 1 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر أغسطس 17, 2021 مشاركة قام بنشر أغسطس 17, 2021 شكراً جزيلاً لهذا المجهود وجزاك الله خير الثواب 3 رابط هذا التعليق شارك More sharing options...
أبو عاصم المصري قام بنشر أغسطس 17, 2021 الكاتب مشاركة قام بنشر أغسطس 17, 2021 بارك الله فيكم، نحن نتعلم منكم. رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.