اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


رمهان

الردود الموصى بها

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

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

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

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

تم تعديل بواسطه رمهان
  • Like 3
رابط هذا التعليق
شارك

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

 

عمل جميل  :yes:

 

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

post-142414-0-26196200-1426595471_thumb.

 

 

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

post-142414-0-09975900-1426595613_thumb.

 

 

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

 

 

جعفر

رابط هذا التعليق
شارك

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 أي بدون إضافة المرجع  والاكتفاء بالربط المتأخر للكائن فمعناته يمكن السبب وجود اصدارين للأوفيس لدي !

 

تحياتي

 

تم تعديل بواسطه رمهان
رابط هذا التعليق
شارك

 

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

 

لا ما ضبطت !!

 

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

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

 

 

جعفر

رابط هذا التعليق
شارك

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

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

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

post-116751-0-34573800-1426660223_thumb.

تم تعديل بواسطه محب لله ورسوله
رابط هذا التعليق
شارك

  • 1 year later...

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

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

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

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

بالتوفيق

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information