ابو جودي قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 السلام عليكم ورحمة الله وبركاته انا عندى مشكلة مش فاهم سببها بصراحة على زر الامر BtnDel كما هو موضح بالصورة مع العلم بأن نفس الكود مستخدم بنفس الالية مع زر الامر BtnDelUnicode بدون اى مشاكل المرفق Converter Arabic and Unicode (v. 3).accdb
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 الان, Barna said: ايش المطلوب ؟؟؟؟ تحويل لنص أم ماذا ؟؟ ايش المطلوب ؟؟؟؟ المطلوب شايف الصورة لما اضغط على زر الامر اللى سوبت لكم عليه سهم يتم حذف قيم مربعات النص اللى على جهة اليساااااااااار المربع اللى به التكويد unicode واللى اسفله اللى به كلمة اوفيسنا اصور لكم افضل صورة متحركة
أفضل إجابة Eng.Qassim قام بنشر يناير 19, 2022 أفضل إجابة قام بنشر يناير 19, 2022 بصراحة ..لم يخطر في بالي غير هذا الكود الذي تم سرقته منك 😄 Me.frmToArabic.SetFocus Me.frmToArabic!txtUnicode.SetFocus Me.frmToArabic!txtUnicode = "" Me.frmToArabic!txtArabic.SetFocus Me.frmToArabic!txtArabic.ControlSource = "" 1 1
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 تجربة بلا فائدة ايضا قمت بعمل الكود الاتى فى الموديول Sub ClearTXTControls(f As Form) On Error GoTo Err_BlankTXTControls Dim i As Integer Dim ctl As Control For i = 0 To f.Count - 1 Set ctl = f(i) If Left$(ctl.Name, 3) = "txt" Then ctl = Null End If Next i Exit_BlankTXTControls: Exit Sub Err_BlankTXTControls: MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_BlankTXTControls End Sub وقمت باستدعاءه على زر الحذف الاول Call ClearTXTControls(Me!frmToUnicode.Form) وتمت العملية بنجاح ولكن عند استدعاءه على زر الحذف الثانى Call ClearTXTControls(Me!frmToArabic.Form) لم يتم حذف القيمة الموجودة بمربع النص الثانى ...... نفس المشكلة
Amr Ashraf قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 54 دقائق مضت, ابو جودي said: المرفق المرفق شغال عادى 😅 اوفيس 2016 32 بيت .. الرسالة دى مش بتظهر 1
Eng.Qassim قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 تفضل استاذي..طريقة مهندس مدني 😄 Converter Arabic and Unicode (v. 3).accdb 1
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 11 دقائق مضت, Eng.Qassim said: بصراحة ..لم يخطر في بالي غير هذا الكود الذي تم سرقته منك 😄 Me.frmToArabic.SetFocus Me.frmToArabic!txtUnicode.SetFocus Me.frmToArabic!txtUnicode = "" Me.frmToArabic!txtArabic.SetFocus Me.frmToArabic!txtArabic.ControlSource = "" اولا جزاكم الله خيرا استاذى الجليل الباش مهندس @Eng.Qassim انا ما خطر ببالى بصراحة انى اتعامل مع مربع النص من خلال ControlSource لانه غير منضم اصلا لذلك اتعاملت معه كقيمة value والغريبة انه بالشق الايمن يعمل بدون مشاكل طيب ايه الحكمة والسبب مش فاهم
Eng.Qassim قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 2 دقائق مضت, ابو جودي said: والغريبة انه بالشق الايمن يعمل بدون مشاكل اعتقد لان النموذج الثاني مصدره النموذج الاول ولهذا كان يعطي خطأ
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 4 دقائق مضت, Eng.Qassim said: اعتقد لان النموذج الثاني مصدره النموذج الاول ولهذا كان يعطي خطأ النماذج غير منضمة اصلا ولا فى اى مصدر بيانات لاى نموذج ولا لأى مربع نص
أبوبسمله قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 16 دقائق مضت, ابو جودي said: النماذج غير منضمة اصلا ولا فى اى مصدر بيانات لاى نموذج ولا لأى مربع نص مشاركه معكم اخى العزيز ابوجودى فالكود التالى تم اضافه البيانات لمصدر عنصر التحكم ل txtArabic Private Sub BtnToArabic_Click() On Error GoTo Err_Handler Me.frmToArabic!txtArabic.ControlSource = "=" & Me.frmToArabic!txtUnicode Exit_Handler: Exit Sub Err_Handler: MsgBox Err.Description Resume Exit_Handler End Sub 1
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 7 دقائق مضت, الفلاحجى said: مشاركه معكم اخى العزيز ابوجودى فالكود التالى تم اضافه البيانات لمصدر عنصر التحكم ل txtArabic Private Sub BtnToArabic_Click() On Error GoTo Err_Handler Me.frmToArabic!txtArabic.ControlSource = "=" & Me.frmToArabic!txtUnicode Exit_Handler: Exit Sub Err_Handler: MsgBox Err.Description Resume Exit_Handler End Sub ايوووووون الله يفتح عليك صح والله نسيت 1 1
Barna قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 28 دقائق مضت, ابو جودي said: النماذج غير منضمة اصلا ولا فى اى مصدر بيانات لاى نموذج ولا لأى مربع نص جرب تغيير الكود المستخدم في الترميز بكود اخر 1
أبوبسمله قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 1 دقيقه مضت, ابو جودي said: ايوووووون الله يفتح عليك صح والله نسيت ويفتحها عليكم اخوانى واحبابى ويزيدكم من فضله وعلمه بالتوفيق اخوانى 1
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 17 دقائق مضت, Barna said: جرب تغيير الكود المستخدم في الترميز بكود اخر مش فاهمك على فكرة انت عارف انا فهمى تقييل ع العموم المرفق النهائى بدون المشكل وبدون اى زيادات التجارب اللى كانت ع الاكواد Converter Arabic and Unicode (v. 3).accdb 1 1
Barna قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 20 دقائق مضت, ابو جودي said: مش فاهمك على فكرة كنت اقصد طريقة تنفيذ الترميز وفك الترميز هناك طريقة اخرى ... اعتقد رأيتها في المنتدى لكن طالما ان المشكلة انحلت .... خلاص ... الحمد لله 1 1
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 14 دقائق مضت, Barna said: كنت اقصد طريقة تنفيذ الترميز وفك الترميز هناك طريقة اخرى ... اعتقد رأيتها في المنتدى انا اريد الاخرى لتعم الفائدة يمكن افضل من فكرتى ونتعلم منها احسك تقول ايش هاد الرخم مشكلته انحلت ومازال رخم بس اوعاك تأتى بفكرة قديمة لى من المنتدى 2
Eng.Qassim قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 منذ ساعه, ابو جودي said: ايوووووون الله يفتح عليك صح والله نسيت مش انا قلتها لك...انا سرقتها منك بس انت مش واخد بالك 😄 1 1
Barna قام بنشر يناير 19, 2022 قام بنشر يناير 19, 2022 هذه طريقة الترميز ..... Dim dgt As String Dim myv As String txts = "" Dim i For i = 1 To Len(txtr) dgt = AscW(Mid(txtr, (i), 1)) txts = txts & "Chrw (" & dgt & ") & " Next i myv = Left(txts, (Len(txts) - 2)) txts = myv وهذه طريقة فك الترميز Loopy = (CDbl(Len([txts]) - Len(Replace([txts], ")", "")))) txtx = "" c0 = 1 Do c1 = Nz(InStr(c0 + 1, Me.txts, "("), 0) c2 = Nz(InStr(c1 + 1, Me.txts, ")"), 0) c3 = c2 - c1 If c1 <> 0 And c2 <> 0 Then c4 = Mid(Me.txts, c1 + 1, c3 - 1) Loopy = Loopy - 1 c0 = c2 Me.txtx = Me.txtx + CHARW(c4) Loop Until Loopy = 0 و هذا هو الفانك ... Function CHARW(CharCode As Variant, Optional Exact_functionality As Boolean = False) As String If UCase(Left$(CharCode, 1)) = "U" Then CharCode = Replace(CharCode, "U", "&H", 1, 1, vbTextCompare) CharCode = CLng(CharCode) If CharCode < 256 Then If Exact_functionality Then CHARW = ChrW(CharCode) Else CHARW = Chr(CharCode) End If Else CHARW = ChrW(CharCode) End If End Function اكيد قديمة ............. صحيح ..... لاني شفت الطريقة هذه من ايام دنيا دنيا ..... هههههههه 2
ابو جودي قام بنشر يناير 19, 2022 الكاتب قام بنشر يناير 19, 2022 الان, Barna said: اكيد قديمة ............. صحيح ..... لاني شفت الطريقة هذه من ايام دنيا دنيا ..... هههههههه بارك الله فى عمرك استاذى الجليل 1 1
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.