اذهب الي المحتوي
أوفيسنا

سؤال: حذف قيمة مربع نص فى نموذج فرعى


ابو جودي
إذهب إلى أفضل إجابة Solved by Eng.Qassim,

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

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

انا عندى مشكلة مش فاهم سببها بصراحة:wallbash:  على زر الامر BtnDel كما هو موضح بالصورة

مع العلم بأن نفس الكود مستخدم بنفس الالية مع زر الامر BtnDelUnicode بدون اى مشاكل 

 

error.png.198594f1363713578b228f142b4eb8c8.png

 

Er.gif.5f343853bcecefd8d1146b82dc8d58bc.gif

المرفق
 

 

Converter Arabic and Unicode (v. 3).accdb

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

الان, Barna said:

ايش المطلوب ؟؟؟؟ تحويل لنص أم ماذا ؟؟

ايش المطلوب ؟؟؟؟ :wallbash::biggrin:

المطلوب شايف الصورة

لما اضغط على زر الامر اللى سوبت لكم عليه سهم 

يتم حذف قيم مربعات النص اللى على جهة اليساااااااااار

المربع اللى به التكويد unicode  واللى اسفله اللى به كلمة اوفيسنا :biggrin:

اصور لكم افضل صورة متحركة

Er.gif

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

  • أفضل إجابة

بصراحة ..لم يخطر في بالي غير هذا الكود الذي تم سرقته منك 😄

    Me.frmToArabic.SetFocus
    Me.frmToArabic!txtUnicode.SetFocus
    Me.frmToArabic!txtUnicode = ""
    Me.frmToArabic!txtArabic.SetFocus
    Me.frmToArabic!txtArabic.ControlSource = ""

 

  • Like 1
  • Haha 1
رابط هذا التعليق
شارك

تجربة بلا فائدة ايضا 

قمت بعمل الكود الاتى  فى الموديول 

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)

لم يتم حذف القيمة الموجودة بمربع النص الثانى ...... نفس المشكلة

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

11 دقائق مضت, Eng.Qassim said:

بصراحة ..لم يخطر في بالي غير هذا الكود الذي تم سرقته منك 😄

    Me.frmToArabic.SetFocus
    Me.frmToArabic!txtUnicode.SetFocus
    Me.frmToArabic!txtUnicode = ""
    Me.frmToArabic!txtArabic.SetFocus
    Me.frmToArabic!txtArabic.ControlSource = ""

 

اولا جزاكم الله خيرا استاذى الجليل الباش مهندس @Eng.Qassim :fff:

انا ما خطر ببالى بصراحة انى اتعامل مع مربع النص من خلال ControlSource

لانه غير منضم اصلا لذلك اتعاملت معه كقيمة value

والغريبة انه بالشق الايمن يعمل بدون مشاكل 

طيب ايه الحكمة والسبب مش فاهم 

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

4 دقائق مضت, Eng.Qassim said:

اعتقد لان النموذج الثاني مصدره النموذج الاول ولهذا كان يعطي خطأ

النماذج غير منضمة اصلا ولا فى اى مصدر بيانات لاى نموذج ولا لأى مربع نص

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

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

 

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

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

 

ايوووووون الله يفتح عليك صح والله نسيت :biggrin:

  • Haha 1
  • Sad 1
رابط هذا التعليق
شارك

1 دقيقه مضت, ابو جودي said:

ايوووووون الله يفتح عليك صح والله نسيت :biggrin:

ويفتحها عليكم اخوانى واحبابى ويزيدكم من فضله وعلمه

بالتوفيق اخوانى

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

17 دقائق مضت, Barna said:

جرب تغيير الكود المستخدم في الترميز بكود اخر

مش فاهمك على فكرة :biggrin: انت عارف انا فهمى تقييل :jump:

ع العموم المرفق النهائى بدون المشكل وبدون اى زيادات التجارب اللى كانت ع الاكواد 

Converter Arabic and Unicode (v. 3).accdb

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

 

20 دقائق مضت, ابو جودي said:

مش فاهمك على فكرة :biggrin: 

كنت اقصد طريقة تنفيذ الترميز وفك الترميز هناك طريقة اخرى ... اعتقد رأيتها في المنتدى

لكن طالما ان المشكلة انحلت .... خلاص ... الحمد لله

  • Like 1
  • Confused 1
رابط هذا التعليق
شارك

14 دقائق مضت, Barna said:

كنت اقصد طريقة تنفيذ الترميز وفك الترميز هناك طريقة اخرى ... اعتقد رأيتها في المنتدى

انا اريد الاخرى لتعم الفائدة 

يمكن افضل من فكرتى ونتعلم منها :yes:
احسك تقول ايش هاد الرخم مشكلته انحلت ومازال رخم :biggrin:

بس اوعاك تأتى بفكرة قديمة لى من المنتدى  :eek2:

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

هذه طريقة الترميز .....

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

اكيد قديمة ............. صحيح ..... لاني شفت الطريقة هذه من ايام دنيا دنيا ..... هههههههه 

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

الان, Barna said:

اكيد قديمة ............. صحيح ..... لاني شفت الطريقة هذه من ايام دنيا دنيا ..... هههههههه 

بارك الله فى عمرك استاذى الجليل :fff:

  • Like 1
  • Thanks 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information