رمهان قام بنشر مارس 17, 2015 مشاركة قام بنشر مارس 17, 2015 (معدل) السلام عليكم ورحمة الله وبركاته احبتي اهدي لكم محاولة بسيطة لموضوع إزالة التشكيل في الاكسس طبعا كان هناك مشاركات حول هذا الموضوع هنا http://www.officena.net/ib/index.php?showtopic=59784 حيث يتلخص الحل بفكرتين : 1. انشاء دالة خاصة تقوم بفحص الاحرف والرموز المستثناه من الابعاد عن النص وما غير ذلك سيتم اعتماده ! انظر استعلام 1 والدالة fn 2. باستخدام إمكانيات الورود في ذلك ! انظر نموذج1 ! لاحظ هنا انه لابد من وضع مرجع للورود من خلال نافذة الكود ملاحظة : استخدمت ملف الأخ السائل في الرابط السابق الأخ "محب لله ورسوله" وذلك لاحتوائه على نص مشكل وفضيل ونسأله سبحانه الثواب والاجر لنا وللأخ صاحب الملف ! تحياتي 'رمهان 'اوفيسنا Public Function fn(fld) y = "أبجدهوزحطيكلمنسعفصقرشتثخذضظغـ ىؤءئةاآإ()><.؟}{][1234567890:,/" For i = 1 To Len(fld) If InStr(1, y, Mid(fld, i, 1)) > 0 Then xx = xx & Mid(fld, i, 1) Next i fn = xx End Function Private Sub أمر0_Click() ''رمهان ''اوفيسنا Set objw = CreateObject("Word.application") Set objd = objw.Documents.Add ''هنا تستطيع عمل شرط على السجلات مثلا الفارغة وذلك لتقليل كثرة عملية التعديل Set rs = CurrentDb.OpenRecordset("جدول_الرسائل"): rs.MoveLast: rs.MoveFirst For i = 1 To rs.RecordCount objd.Range.Text = rs(1) objw.Selection.Find.ClearFormatting objw.Selection.Find.Replacement.ClearFormatting With objw.Selection.Find .Text = "[ً-ْ]" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With objw.Selection.Find.Execute Replace:=wdReplaceAll DoCmd.RunSQL "update جدول_الرسائل set حقل1='" & objd.Range.Text & "' where مفتاح_أساسي=" & rs(0) rs.MoveNext Next i Set objd = Nothing objw.Application.Quit SaveChanges:=wdDoNotSaveChanges Set objw = Nothing Set objd = Nothing End Sub التشكيل.rar تم تعديل مارس 17, 2015 بواسطه رمهان 3 رابط هذا التعليق شارك More sharing options...
محمد سلامة قام بنشر مارس 17, 2015 مشاركة قام بنشر مارس 17, 2015 بارك الله فيك استاذ رمهان رابط هذا التعليق شارك More sharing options...
ابو الآء قام بنشر مارس 17, 2015 مشاركة قام بنشر مارس 17, 2015 بارك الله فيك رابط هذا التعليق شارك More sharing options...
jjafferr قام بنشر مارس 17, 2015 مشاركة قام بنشر مارس 17, 2015 عليكم السلام أخي رمهان عمل جميل بس لما شغلته ظهر لي انك مستعمل الاوفيس 2013 ، لهذا السبب ، مرجع اللوورد مفقود عندي (انا استعمل اكسس 2010): فبدل ما اخلي لي مرجع الوورد 2010 ، عملت التالي (اللي في المربع الاحمر ، استعملت الـ Object): بهذه الطريقة ، فالبرنامج لا يحتاج الى اي مرجع ، ويشتغل على كل انواع الوورد جعفر رابط هذا التعليق شارك More sharing options...
رمهان قام بنشر مارس 17, 2015 الكاتب مشاركة قام بنشر مارس 17, 2015 (معدل) Private Sub أمر0_Click() ''رمهان ''اوفيسنا Dim objw As Object Dim objd As Object Set objw = CreateObject("Word.application") Set objd = objw.Documents.Add objw.Visible = True ''هنا تستطيع عمل شرط على السجلات مثلا الفارغة وذلك لتقليل كثرة عملية التعديل Set rs = CurrentDb.OpenRecordset("جدول_الرسائل"): rs.MoveLast: rs.MoveFirst For i = 1 To rs.RecordCount objd.Range.Text = rs(1) objw.Selection.Find.ClearFormatting objw.Selection.Find.Replacement.ClearFormatting With objw.Selection.Find .Text = "[ً-ْ]" .Replacement.Text = "" .Forward = True .Wrap = wdFindAsk .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchAllWordForms = False .MatchSoundsLike = False .MatchWildcards = True End With objw.Selection.Find.Execute Replace:=wdReplaceAll DoCmd.RunSQL "update جدول_الرسائل set حقل1='" & objd.Range.Text & "' where مفتاح_أساسي=" & rs(0) rs.MoveNext Next i Set objd = Nothing objw.Application.Quit SaveChanges:=wdDoNotSaveChanges Set objw = Nothing Set objd = Nothing End Sub الجميل مرورك أستاذ جعفر ومشاركتك ! لو لاحظت في الكود بعدم استخدام جملة اجبار تعريف المتغيرات في اعلى الوحدة النمطية! فاصبح المتغيرين objw و objd متغيرين من نوع كائن ضمنيا باستخدام جملة creatareobject عزيزي جعفر : تابع معي في : 1. اضف السطر objw.Visible = True في البداية وبعد تعريف الكائنات : لتقريب فكرة عمل البرنامج 2. جرب بطريقتك وبدون مرجع هل تم حذف التشكيل : يمكن مراقبة النص المتغير بملف الوورد الظاهر 3 . طبعا كلنا نعرف ربط الكائنات المبكر والمتاخر ! فباستخدام createobject لم يعد هناك لازم في إضافة المرجع ولكن حدث ان الكود لم يعمل بالشكل المطلوب فعملية البحث والاستبدال لم تقوم بعملها وهذا ما جعلني اعمل لساعات طويلة في إيجاد المشكلة وعند اضافة المرجع بشكل صريح من المراجع نجحت العملية 4. اقصد بالمرجع حسب اصدار الاوفيس لديك فكل حسب الإصدار المتاح ملاحظة : اذا ضبطت معاك النقطة رقم 2 أي بدون إضافة المرجع والاكتفاء بالربط المتأخر للكائن فمعناته يمكن السبب وجود اصدارين للأوفيس لدي ! تحياتي تم تعديل مارس 17, 2015 بواسطه رمهان رابط هذا التعليق شارك More sharing options...
yms12 قام بنشر مارس 17, 2015 مشاركة قام بنشر مارس 17, 2015 ما شاء الله رابط هذا التعليق شارك More sharing options...
jjafferr قام بنشر مارس 17, 2015 مشاركة قام بنشر مارس 17, 2015 ملاحظة : اذا ضبطت معاك النقطة رقم 2 أي بدون إضافة المرجع والاكتفاء بالربط المتأخر للكائن فمعناته يمكن السبب وجود اصدارين للأوفيس لدي ! لا ما ضبطت !! يمكن في شئ آخر لازم تعمله !! على العموم ، مادام يشتغل ، فهو المطلوب ، مع وضع ملاحظة عن المرجع االمستخدم جعفر رابط هذا التعليق شارك More sharing options...
محب لله ورسوله قام بنشر مارس 18, 2015 مشاركة قام بنشر مارس 18, 2015 (معدل) جزاك الله خيرا أخى الحبيب ونفع الله بك قابلتنى هذه المشكله عند تشغيل الاستعلام فأجروا منك توضيح الحل تم تعديل مارس 18, 2015 بواسطه محب لله ورسوله رابط هذا التعليق شارك More sharing options...
محب لله ورسوله قام بنشر مارس 31, 2016 مشاركة قام بنشر مارس 31, 2016 ارجو المساعده فى حل الرساله التى تظهر عند التشغيل رابط هذا التعليق شارك More sharing options...
رمهان قام بنشر أبريل 1, 2016 الكاتب مشاركة قام بنشر أبريل 1, 2016 حياك الله اخي الكريم يمكن ان تكون المشكلة في المراجع لديك فمن خلال نافذة الكود اذاهب الى القائمة ادوات ثم مراجع وشوف المراجع لديك او ارفق ملفك الذي به المشكلة ! بالتوفيق رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان