ازالة التشكيل في الاكسس

[رمهان]

السلام عليكم ورحمة الله وبركاته احبتي

اهدي لكم محاولة بسيطة لموضوع إزالة التشكيل في الاكسس

طبعا كان هناك مشاركات حول هذا الموضوع هنا

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 بواسطه رمهان

[محمد سلامة]

بارك الله فيك استاذ رمهان

[ابو الآء]

بارك الله فيك

[jjafferr]

عليكم السلام أخي رمهان 

 

عمل جميل 

 

بس لما شغلته ظهر لي انك مستعمل الاوفيس 2013 ، لهذا السبب ، مرجع اللوورد مفقود عندي (انا استعمل اكسس 2010):

 

 

فبدل ما اخلي لي مرجع الوورد 2010 ، عملت التالي (اللي في المربع الاحمر ، استعملت الـ Object):

 

 

بهذه الطريقة ، فالبرنامج لا يحتاج الى اي مرجع ، ويشتغل على كل انواع الوورد 

 

 

جعفر

[رمهان]

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 بواسطه رمهان

[yms12]

ما شاء الله

[jjafferr]

 

ملاحظة : اذا ضبطت معاك النقطة رقم 2 أي بدون إضافة المرجع  والاكتفاء بالربط المتأخر للكائن فمعناته يمكن السبب وجود اصدارين للأوفيس لدي !

 

لا ما ضبطت !!

 

يمكن في شئ آخر لازم تعمله !!

على العموم ، مادام يشتغل ، فهو المطلوب ، مع وضع ملاحظة عن المرجع االمستخدم 

 

 

جعفر

[محب لله ورسوله]

جزاك الله خيرا أخى الحبيب ونفع الله بك

قابلتنى هذه المشكله عند تشغيل الاستعلام

فأجروا منك توضيح الحل

تم تعديل مارس 18, 2015 بواسطه محب لله ورسوله

[محب لله ورسوله]

ارجو المساعده فى حل الرساله التى تظهر عند التشغيل

[رمهان]

حياك الله اخي الكريم

يمكن ان تكون المشكلة في المراجع لديك

فمن خلال نافذة الكود اذاهب الى القائمة ادوات ثم مراجع وشوف المراجع لديك 

او ارفق ملفك الذي به المشكلة !

بالتوفيق