بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
البحث في الموقع
Showing results for tags 'التشكيل تشكيل تلوين رمهان'.
تم العثور علي 1 نتيجه
-
السلام عليكم ورحمة الله وبركاته احبتي اهدي لكم محاولة بسيطة لموضوع إزالة التشكيل في الاكسس طبعا كان هناك مشاركات حول هذا الموضوع هنا 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
