أبو عاصم المصري قام بنشر نوفمبر 22, 2020 قام بنشر نوفمبر 22, 2020 أحبائي الكرام، كنت أعمل في ملف فيه مئات من الأبيات الشعرية المأخوذة من الملف بغرض فهرستها، ومن المعلوم أن ترتيب الشعر يكون حسب القافية، فيكون الترتيب على حسب الحرف الأخير (القافية) من الكلمة التي تحتوي على القافية، وكان هذا الأمر يحتاج وقتا وجهدا كبيرين، لأن الفرز (الترتيب) في الورد ليس فيه هذه الخاصية، فأعددت ماكرو بصورة بسيطة يقوم بترتيب الأبيات الشعرية على الحرفين الأخيرين من القافية، بغض النظر عن (الألف والواو والياء والهاء) لأنها ربما تكون في في آخر الكلمة وليست هي القافية، فتركتها كما هي، وعلى الباحث أن يضعها في ترتيبها بطريقة يدوية، وهذه المواضع غالبا ما تكون قليلة، علما بأني من الهواة، لكن لما نفعت الفكرة وساعدتني كثيرا أحببت مشاركة إخواني، عسى أن يعم نفعها. * ويشترط أن تكون الأبيات ضمن جدول، وأن يوجد الشطران، وألا يكون في الصفحة إلا جدول الشعر فقط، بمعنى أنه لا يوجد عنوان مثلا قبل الفهرس، مثل: فهرس الشعر، ويمكن أن تضيفة بعد الترتيب الآلي واليدوي: وهذا هو الماكرو: ' ' شعرعماد Macro 'ماكرو ترتيب أبيات شعرية في جدول، ولا بد أن يكون هناك جدول فقط 'ويشترط وجود الشطرين Selection.Tables(1).Select Selection.Font.Color = wdColorAutomatic Selection.HomeKey Unit:=wdStory Selection.MoveRight Unit:=wdCell Selection.MoveRight Unit:=wdCell Selection.SelectColumn Selection.Font.Color = wdColorRed Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Font.Color = wdColorRed Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "<[! ]@>[! :.،؛\؟\!]" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With For i = 1 To 1000 Selection.Find.Execute Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Copy If Selection.Find.Found = False Then Selection.HomeKey Unit:=wdStory Exit For MsgBox "لا توجد كلمات حمراء" End If Selection.Font.Color = wdColorAutomatic Selection.HomeKey Unit:=wdRow, Extend:=True Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.PasteAndFormat (wdPasteDefault) Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend Selection.Font.Color = 12611584 Selection.HomeKey Unit:=wdLine Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1, name:="" Selection.Find.ClearFormatting Selection.Find.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 .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Next i Selection.Find.ClearFormatting Selection.Find.Font.Color = 12611584 Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[ًٌٍَُِّْ]" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .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 replace:=wdReplaceAll Selection.Find.ClearFormatting Selection.Find.Font.Color = 12611584 Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "[ًٌٍَُِّْ]" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With Selection.Find.ClearFormatting Selection.Find.Font.Color = 12611584 Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "<[! ]@>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With For i = 1 To 1000 Selection.Find.Execute If Selection.Find.Found = False Then Selection.HomeKey Unit:=wdStory Exit For MsgBox "لا توجد كلمات زرقاء" End If Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.MoveLeft Unit:=wdCharacter, Count:=2 Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend Selection.Delete Unit:=wdCharacter, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend Selection.Cut Selection.MoveRight Unit:=wdCharacter, Count:=1 Selection.PasteAndFormat (wdPasteDefault) Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend Selection.Font.Color = 5287936 Next i Selection.HomeKey Unit:=wdLine Selection.Sort ExcludeHeader:=False, FieldNumber:="عمود 1", SortFieldType _ :=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending, FieldNumber2 _ :="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _ wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _ wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _ wdSortSeparateByCommas, SortColumn:=False, CaseSensitive:=False, _ LanguageID:=wdArabic, SubFieldNumber:="فقرات", SubFieldNumber2:="فقرات", _ SubFieldNumber3:="فقرات" Selection.Sort BidiSort:=False, IgnoreThe:=True, IgnoreKashida:=False, _ IgnoreDiacritics:=False, IgnoreHe:=False Selection.HomeKey Unit:=wdStory Selection.Find.ClearFormatting Selection.Find.Font.Color = 5287936 Selection.Find.Replacement.ClearFormatting With Selection.Find .Text = "<[! ]@>" .Replacement.Text = "" .Forward = True .Wrap = wdFindContinue .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 replace:=wdReplaceAll Selection.Tables(1).Select Selection.Font.Color = wdColorAutomatic Selection.HomeKey Unit:=wdStory End Sub
أبو عاصم المصري قام بنشر نوفمبر 22, 2020 الكاتب قام بنشر نوفمبر 22, 2020 (معدل) تم تعديل نوفمبر 22, 2020 بواسطه أبو عاصم المصري
أبو عاصم المصري قام بنشر نوفمبر 22, 2020 الكاتب قام بنشر نوفمبر 22, 2020 هذه صورة الجدول قبل الترتيب: رُبَّ مَنْ أنضَجتُ غيظًا قلبَهُ قد تمنَّى لي موتًا لم يُطَعْ رُبَّما تَكْرَهُ النُّفُوسُ من الأمْر ما لَهُ فَرْجةٌ كَحَلِّ العِقالِ سَراةُ بَني أبي بَكْرٍ تَسامَوْا عَلَى كانَ المُسَوَّمةِ العِرابِ عُمَيرةَ ودِّعْ إنْ تَجَهَّزْتَ غادِيا كَفَي الشّيْبُ والإسْلامُ لِلْمَرْءِ ناهِيا قلّدوها تمائمًا خوفَ عينٍ وحاسِدِ كُلُوا في بعضِ بطنِكمُ تَعِفُّوا فإنّ زمانَكمْ زمنٌ خميصُ لا تَحْظُرِ العَفْوَ إنْ كنتَ امْرَءًا حَرِجًا فإنّ حَظْرَكهُ للدِّينِ إزْراءُ لا يَسْألُونَ أخاهُمْ حِينَ يَنْدُبُهُمْ للنّائِباتِ عَلَى ما قالَ بُرْهانا لِسانُ الفَتى نِصْفٌ ونِصفٌ فُؤادُه فَلَمْ يَبْقَ إلّا صُورةُ اللّحمِ والدّمِ مَساميحُ الفِعالِ ذَوُو أناةٍ مراجيحٌ وأوجُهُهُمْ وِضاءُ مَنطِق صائب وتلحَن أحْيانًا وخيْرُ الكَلامِ ما كانَ لحنَا وإنْ تَسْألونِي بالنِّساءِ فإنَّني خبيرٌ بأدْواءِ النِّساءِ طَبِيبُ وإنّ لسانَ المرءِ ما لم تكنْ له حصاةٌ على عَوراتهِ لَدَليلُ وإنّ لِسانَ المَرْء ما لَمْ يَكُنْ لَه حَصاةٌ عَلى عَوْراتِه لَدَلِيلُ وإنِّي وإن أوْعَدْتُه أو وعَدْتُهُ لمنجزُ إيعادي ومُخْلِفُ مَوْعِدي وهذه صورته بعد الترتيب: لا تَحْظُرِ العَفْوَ إنْ كنتَ امْرَءًا حَرِجًا فإنّ حَظْرَكهُ للدِّينِ إزْراءُ مَساميحُ الفِعالِ ذَوُو أناةٍ مراجيحٌ وأوجُهُهُمْ وِضاءُ لا يَسْألُونَ أخاهُمْ حِينَ يَنْدُبُهُمْ للنّائِباتِ عَلَى ما قالَ بُرْهانا مَنطِق صائب وتلحَن أحْيانًا وخيْرُ الكَلامِ ما كانَ لحنَا عُمَيرةَ ودِّعْ إنْ تَجَهَّزْتَ غادِيا كَفَي الشّيْبُ والإسْلامُ لِلْمَرْءِ ناهِيا سَراةُ بَني أبي بَكْرٍ تَسامَوْا عَلَى كانَ المُسَوَّمةِ العِرابِ وإنْ تَسْألونِي بالنِّساءِ فإنَّني خبيرٌ بأدْواءِ النِّساءِ طَبِيبُ قلّدوها تمائمًا خوفَ عينٍ وحاسِدِ كُلُوا في بعضِ بطنِكمُ تَعِفُّوا فإنّ زمانَكمْ زمنٌ خميصُ رُبَّ مَنْ أنضَجتُ غيظًا قلبَهُ قد تمنَّى لي موتًا لم يُطَعْ رُبَّما تَكْرَهُ النُّفُوسُ من الأمْر ما لَهُ فَرْجةٌ كَحَلِّ العِقالِ وإنّ لسانَ المرءِ ما لم تكنْ له حصاةٌ على عَوراتهِ لَدَليلُ وإنّ لِسانَ المَرْء ما لَمْ يَكُنْ لَه حَصاةٌ عَلى عَوْراتِه لَدَلِيلُ لِسانُ الفَتى نِصْفٌ ونِصفٌ فُؤادُه فَلَمْ يَبْقَ إلّا صُورةُ اللّحمِ والدّمِ وإنِّي وإن أوْعَدْتُه أو وعَدْتُهُ لمنجزُ إيعادي ومُخْلِفُ مَوْعِدي
أبو عاصم المصري قام بنشر نوفمبر 22, 2020 الكاتب قام بنشر نوفمبر 22, 2020 وهنا نقوم بطريقة يدوية بنقل البيت الذي آخره (برهانا) إلى موضعه في حرف النون، و(ناهيا) إلى موضعه في حرف الياء، وهكذا.
vetakita قام بنشر يناير 1, 2021 قام بنشر يناير 1, 2021 أحبائي الكرام، كنت أعمل في ملف فيه مئات من الأبيات الشعرية المأخوذة من الملف بغرض فهرستها، ومن المعلوم أن ترتيب الشعر يكون حسب القافية، فيكون الترتيب على حسب الحرف الأخير (القافية) من الكلمة التي تحتوي على القافية، وكان هذا الأمر يحتاج وقتا وجهدا كبيرين، لأن الفرز (الترتيب) في الورد ليس فيه هذه الخاصية، فأعددت ماكرو بصورة بسيطة يقوم بترتيب الأبيات الشعرية على الحرفين الأخيرين من القافية، بغض النظر عن (الألف والواو والياء والهاء) لأنها ربما تكون في في آخر الكلمة وليست هي القافية، فتركتها كما هي، وعلى الباحث أن يضعها في ترتيبها بطريقة يدوية، وهذه المواضع غالبا ما تكون قليلة، علما بأني من الهواة، لكن لما نفعت الفكرة وساعدتني كثيرا أحببت مشاركة إخواني، عسى أن يعم نفعها.
vetakita قام بنشر يناير 2, 2021 قام بنشر يناير 2, 2021 من الكلمة التي تحتوي على القافية، وكان هذا الأمر يحتاج وقتا وجهدا كبيرين، لأن الفرز (الترتيب) في الورد ليس فيه هذه الخاصية، فأعددت ماكرو بصورة بسيطة يقوم بترتيب الأبيات الشعرية على الحرفين الأخيرين من القافية، بغض النظر عن (الألف والواو والياء والهاء) لأنها ربما تكون في في آخر الكلمة وليست هي القافية، فتركتها كما هي، وعلى الباحث أن يضعها في ترتيبها بطريقة يدوية، وهذه المواضع غالبا ما تكون قليلة، علما بأني من الهواة، لكن لما نفعت الفكرة وساعدتني كثيرا أحببت مشاركة إخواني، عسى أن يعم نفعها. Speed Test
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.