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

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

قام بنشر

سلام عليكم احبایی الکرام مرة اخری

في هذا النموذج نريد تکسیر الحروف علی اصول اتی نریدها

مثلا نرید:  ع  م  ا  ن

یصبح    :  ن ع  ا  م

الاصول:  حروفـ  (1  2  3  4)  تتحول الی (4  1  3  2)

وشکرا علی مساعدتکم

 

Untitled32.png

قام بنشر
1 ساعه مضت, سید منصور هاشمی said:

سلام عليكم احبایی الکرام مرة اخری

في هذا النموذج نريد تکسیر الحروف علی اصول اتی نریدها

مثلا نرید:  ع  م  ا  ن

یصبح    :  ن ع  ا  م

الاصول:  حروفـ  (1  2  3  4)  تتحول الی (4  1  3  2)

وشکرا علی مساعدتکم

 

Untitled32.png

وعليكم السلام ورحمة الله وبركاته .. الأخ سيد

 

ماهي القاعدة التي تبني عليها ؟

لو أخذنا كلمة : س ي د ……مثلا

كيف ستكون النتيجة ؟

 

  • Like 1
قام بنشر

س ی د       =>   د س ی

انا آسف لئن ما الی ای خبره بس ارید شی بهذا المثال

 

Private Sub Command8_Click()
Dim LString As String
Dim LArray() As String

LString = Me.txt
LArray = Split(LString)

Me.Text00 = LArray(7) & " " & LArray(0) & " " & LArray(6) & " " & LArray(1) & " " & LArray(5) & " " & LArray(2) & " " & LArray(4) & " " & LArray(3)


End Sub

 

قام بنشر
Dim OriginStr As String
Dim RevStr As String
Dim NextChar As String
Dim Length As Integer
Dim Pos As Integer

OriginStr = (Me.Text00)
 
Length = Len(OriginStr)
 
RevStr = ""
 
For Pos = Length To 1 Step -1
 
    NextChar = Mid(OriginStr, Pos, 1)
    RevStr = RevStr & NextChar
Next Pos
 
Me.Text01 = RevStr

 

قام بنشر (معدل)

أهلا أخي سيد تم بحمد الله نجاح التجربة 🙂 

image.gif.5b4e5b4f37d0924805c6c48d089b45e0.gif

وهذه هي الأكواد المستخدمة والدالة المكسرة للكلام :biggrin:

Public Function RandomizeTxt(TXT As String) As String

Dim x As Double
Dim y As String
Dim m As Double
Dim L As String
Dim R As String

y = Replace(TXT, " ", "")
m = Len(y) / 2

If InStr(1, m, ".") > 0 Then
    y = Replace(y, Mid(y, m + 0.5, 1), Mid(y, m + 0.5, 1) & " ")
End If

R = StrReverse(y)

For x = 1 To m + 0.5
    L = L & Mid(R, x, 1) & " " & Mid(y, x, 1) & " "
Next

RandomizeTxt = Trim(Replace(Replace(L, "  ", ""), "  ", " "))
End Function

المرفق :

 

تم تعديل بواسطه Moosak
تم تعديل الكود ولكن حمل المرفق المعدل من المشاركة القادمة :)
  • Like 4
قام بنشر (معدل)

حقیقتا شی عجیب 😉

حضرتک خبیر بکل معناه بهذا العلم

احسنتم جزاک الله خیرا اخی العزیز🌺

تم تعديل بواسطه سید منصور هاشمی
  • Like 1
قام بنشر

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

اخى واستاذى موسى @Moosak جزاك الله خيرا 🌹

ملحوظه بسيطه اخى على كودك الرائع وتسلم ايدك 💐

استبدل هذا الجزء من الكود

If InStr(1, m, ".") > 0 Then
    TXT = TXT & " "
End If

الى

If InStr(1, m, ".") > 0 Then
    TXT = TXT
End If

بالتوفيق

قام بنشر
48 دقائق مضت, سید منصور هاشمی said:

حقیقتا شی عجیب 😉

حضرتک خبیر بکل معناه بهذا العلم

احسنتم جزاک الله خیرا اخی العزیز🌺

العفو أخي سيد ..

ذلك فضل الله .. 🙂

7 دقائق مضت, احمد الفلاحجي said:

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

اخى واستاذى موسى @Moosak جزاك الله خيرا 🌹

ملحوظه بسيطه اخى على كودك الرائع وتسلم ايدك 💐

استبدل هذا الجزء من الكود

وعليكم السلام ورحمة الله وبركاته أخي الحبيب @احمد الفلاحجي 

العفو حبيبنا بارك الله فيك 🙂

في الحقيقة هذا الجزء حل لي مشكلة إذا كان عدد الحروف فردي وتمت قسمته على 2 بيطلع لنا كسور وسيتم تكرار الحرف الأوسط مرتين ، لذلك زودت المسافة علشان دايما يكون العدد زوجي وتشتغل الدالة صح 😉👌🏻

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

فكرة جميلة جدا استاذ @Moosak ..لكن لم اجد فائدة من هذا الجزء

If InStr(1, m, ".") > 0 Then
    TXT = TXT & " "
End If

 

ولذلك زودت هذا الجزء باش مهندس قاسم 😁✌️🏻

وللتأكد قم بتجميد هذي الجزئية .. وجرب تحط كلمة من خمسة حروف مثلا .. وشوف الفرق ب و بدون

  • Like 1
قام بنشر
4 دقائق مضت, Moosak said:

ولذلك زودت هذا الجزء

😍الان توضحت الرؤيا ان كان العدد فردي

دائما مبدع استاذ موسى

  • Like 1
قام بنشر
6 دقائق مضت, Moosak said:

في الحقيقة هذا الجزء حل لي مشكلة إذا كان عدد الحروف فردي وتمت قسمته على 2 بيطلع لنا كسور وسيتم تكرار الحرف الأوسط مرتين ، لذلك زودت المسافة علشان دايما يكون العدد زوجي وتشتغل الدالة صح 😉👌🏻

صحيح ما ذكرت طيب بدله بقى حتى يتم ضبط الحروف بالعكس لانه بيجيب اول حرف كما هو

If InStr(1, m, ".") > 0 Then
    TXT = " " & TXT
End If

بالتوفيق

  • Like 1
قام بنشر

ملحوظه هامه:

اذا کان النص ، حروف مزدوجه (4  6  8  10  12  14)  فلقاعده  ما فیها خطا وهی صحیحه و ممیزه

ولکن اذا کان النص ، حروفها مفرده (5  7   9   13  15) و هذا خطا

هل احد من الاساتید لدیه فکره؟؟

قام بنشر (معدل)
12 ساعات مضت, سید منصور هاشمی said:

ملحوظه هامه:

اذا کان النص ، حروف مزدوجه (4  6  8  10  12  14)  فلقاعده  ما فیها خطا وهی صحیحه و ممیزه

ولکن اذا کان النص ، حروفها مفرده (5  7   9   13  15) و هذا خطا

هل احد من الاساتید لدیه فکره؟؟

الحمدلله تم تصحيح هذا الخطأ 🙂 :

image.png.ab11a9fa3808683d78a321870b05a88c.png

وتم تعديل الكود :

 

Public Function RandomizeTxt(TXT As String) As String

Dim x As Double
Dim y As String
Dim m As Double
Dim L As String
Dim R As String

y = Replace(TXT, " ", "")
m = Len(y) / 2

If InStr(1, m, ".") > 0 Then
    y = Replace(y, Mid(y, m + 0.5, 1), Mid(y, m + 0.5, 1) & " ")
End If

R = StrReverse(y)

For x = 1 To m + 0.5
    L = L & Mid(R, x, 1) & " " & Mid(y, x, 1) & " "
Next

RandomizeTxt = Trim(Replace(Replace(L, "  ", ""), "  ", " "))
End Function

 

 

تجربة تكسير الكلام (1).accdb

تم تعديل بواسطه Moosak
تم تعديل الكود من جديد بسبب ظهور أخطاء في الجمل الفردية :)
  • Like 1
قام بنشر

ماااااااااااشاااااااااااااااااا الله علیک ک ک ک ک ک ک ک 😊😉😌

میمیز جدا جدا....

تسلم حیاتک و انا اشکرک اخی و استاذی Moosak و اشکر الجمیع 

  • Like 1
قام بنشر

أخي سید منصور هاشمی  قمت بتعديلات جديدة على الكود ..

فقد ظهرت لي أخطاء جديدة فجعلته هذه المرة يتجاهل المسافات ثم يضيفها من جديد لتجنب وقوع الأخطاء 🙂  

حمل نفس الملف الأخير 

 

  • Like 1
قام بنشر
16 ساعات مضت, Moosak said:

image.gif.5b4e5b4f37d0924805c6c48d089b45e0.gif

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

  • Like 1
قام بنشر (معدل)

استاذ موسی : شاهدت خطا فی تکسیر الحروف ما بین الحقیقیه و الماخوذه من الملف

تکسیر الحروف الحقیقیه لـ { بسم الله الرحمن الرحیم } = م ب ی س ح م ر ا ل ل ا ل ن ه م ا ح ل ر

تکسیر الحروف الملف نفس الجمله                           = م ب ی س ح م ا ر ل ل ل ا ه ن ا م ل ح ر

کما تشاهد ، الی 6 حروف الاولی ، هیه صحیحه و من بعدها تتحول الی خطا .....

 

5555.png

تم تعديل بواسطه سید منصور هاشمی
قام بنشر (معدل)
في 30‏/4‏/2022 at 16:40, MansurH said:

استاذ موسی : شاهدت خطا فی تکسیر الحروف ما بین الحقیقیه و الماخوذه من الملف

تکسیر الحروف الحقیقیه لـ { بسم الله الرحمن الرحیم } = م ب ی س ح م ر ا ل ل ا ل ن ه م ا ح ل ر

تکسیر الحروف الملف نفس الجمله                           = م ب ی س ح م ا ر ل ل ل ا ه ن ا م ل ح ر

کما تشاهد ، الی 6 حروف الاولی ، هیه صحیحه و من بعدها تتحول الی خطا .....

 

5555.png

السلام عليكم ورحمة الله وبركاته أخي سيد ..

تم تعديل الكود ليتلافى هذا الخطأ 🙂 

Public Function RandomizeTxt(TXT As String) As String

Dim x As Double
Dim y As String
Dim m As Double
Dim L As String
Dim R As String

y = Replace(TXT, " ", "")
m = Len(y) / 2

R = StrReverse(y)

For x = 1 To m + 0.5
    L = L & Mid(R, x, 1) & " " & Mid(y, x, 1) & " "
Next

If InStr(1, m, ".") > 0 Then
    L = Left(Trim(L), Len(L) - 2)
End If
RandomizeTxt = Trim(Replace(Replace(L, "  ", ""), "  ", " "))

End Function

image.png.9482cf78738335e125f1f2488523af33.png

تجربة تكسير الكلام (1).accdb

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

اخی موسی 

سلام علیکم ورحمة الله. عید سعید انشاله و انتم من العوادین. قبل الله اعمالکم

شکرا جزیلا لاسمترار مساعدتک 

  • 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