مساعدة في كود لقص النص المحدد ووضعه في الصفحة التالية أو السابقة

[nssj]

الإخوة الكرام .. أحتاج إلى كود يقوم بقص النص الذي تم تحديده بالفأرة ثم يضعه في أول الصفحة التالية أو آخر الصفحة السابقة

وفي الملف المرفق محاولتي بهذا الخصوص، وهي ناقصة من جهتين:

1- الذي قمت به قص النص كله، والمطلوب قص النص المحدد فقط وليس كل النص

2- تمكنت من لصق النص في الموضع المطلوب في آخر الصفحة السابقة أو أول الصفحة التالية، ولا مشكلة إن كانت الصفحة المطلوب اللصق فيها فارغة، المشكلة التي واجهتني هي وجود نص في الصفحة فلا بد حينها من لص النص في فقرة مستقلة وليس ملتصقا بالنص القديم

ففي حالة اللصق في التالية المطلوب لصق النص المحدد في أول الصفحة التالية، ويليها في سطر جديد النص القديم

وفي حالة اللصق في السابقة المطلوب لصق النص في سطر جديد بعد النص القديم

DoCmd.RunCommand acCmdCut
DoCmd.GoToRecord , "", acPrevious
Me.nass.SelStart = Me.nass.SelLength
DoCmd.RunCommand acCmdPaste

 

BOOK.accdb

[kanory]

23 ساعات مضت, nssj said:

الإخوة الكرام .. أحتاج إلى كود يقوم بقص النص الذي تم تحديده بالفأرة ثم يضعه في أول الصفحة التالية أو آخر الصفحة السابقة

وفي الملف المرفق محاولتي بهذا الخصوص، وهي ناقصة من جهتين:

1- الذي قمت به قص النص كله، والمطلوب قص النص المحدد فقط وليس كل النص

2- تمكنت من لصق النص في الموضع المطلوب في آخر الصفحة السابقة أو أول الصفحة التالية، ولا مشكلة إن كانت الصفحة المطلوب اللصق فيها فارغة، المشكلة التي واجهتني هي وجود نص في الصفحة فلا بد حينها من لص النص في فقرة مستقلة وليس ملتصقا بالنص القديم

ففي حالة اللصق في التالية المطلوب لصق النص المحدد في أول الصفحة التالية، ويليها في سطر جديد النص القديم

وفي حالة اللصق في السابقة المطلوب لصق النص في سطر جديد بعد النص القديم

طيب تفضل جرب المرفق التالي حسب فهمي للموضوع <><><><><>

 

BOOK (2).accdb

[nssj]

جزاك الله أخي الكريم .. ما قمت به قد حقق 90% من المطلوب .. أحيانا وليس دائماً 🤔 !!

هذا بعد أن قمت بتعديل بسيط عليه .. وقد كنتُ في غنى عن هذا لو أنني استطعت أن أشرح لك المطلوب بشكل أفضل بخصوص اللصق في التالية أو السابقة وفي أول الكلام أو آخره

ولأن الصورة واضحة بالنسبة لي وصلت للمطلوب بحمد الله ببعض التعديلات التي ستراها في الملف المرفق، فقد أبقيت على الجمل التي كتبتَها مع (‘)

* المشكلة في الظاهرة الغريبة التي ظهرت عندي أنه عند اللصق لا تظهر الجملة التي تم قصها إنما يظهر (v) (c)

وجربت أن ألغي السطر

'Call SendKeys("^c", True)

وزبطت  .. ومضيت في التجارب لكن لم يدم الأمر .. رجعت الحروف بالظهور بدل الكلام .. وإذا أعدت الكرة وفعَّلت هذا السطر ثم ألغيته يعمل الكود لبعض الوقت ثم تعود هذه الحروف بالظهور

* أما الـ  10%  المتبقية فهي أنه إذا لم يتم تحديد شيء فإن الكود يقص الكلام كله .. والأفضل أنه إذا لم يتم تحديد شيء من الكلام ألا يعمل الكود أو يخرج رسالة

وحاولت أعمل حالي معلِّم  🙂 وأضفت هذه الأسطر

Me.cop.SetFocus
Me.cop = ""
DoCmd.RunCommand acCmdPaste
Refresh
If IsNull(cop) Or cop = "" Then
MsgBox "لم تقم بتحديد النص المطلوب", vbExclamation
Me.nass.SetFocus
Exit Sub
End If

لكن هالمرة ما زبطت 🙄

* كما ولا حظت أن مفتاح (Num Lock) يتغير عندما أستخدم الكود .. بيشتغل وبيطفي .. وأيضاً ليس في كل مرة !!

BOOK (3).accdb

[kanory]

🙄

[kanory]

طيب جرب الملف والتعديلات الموجوده بها واعلمنا بالنتيجة <><><><><><><>

 

BOOK (2).accdb

[nssj]

هذه الرسالة التي تظهر عند فتح الملف .. والأوفس عندي (2013)

وأنا عادة عندما أرى مثل هذه الأسطر الحمراء أرفع الراية البيضاء .. وأكف عن التجارب والتخبيصات 😁

[Barna]

31 دقائق مضت, nssj said:

هذه الرسالة التي تظهر عند فتح الملف .. والأوفس عندي (2013)

وأنا عادة عندما أرى مثل هذه الأسطر الحمراء أرفع الراية البيضاء .. وأكف عن التجارب والتخبيصات 😁

مشاركة مع استاذي @kanory تفضل .......

 

BOOK (2).accdb

[nssj]

الآن أصبحت تظهر هذه الرسالة .. واعذروني أيها الإخوة الكرام .. الكود معقد بالنسبة لمبتدئ مثلي ومن الصعب علي معالجة  هذه المشاكل بنفسي 😐

 

[Barna]

هل الاوفيس لديك 64Bit

[nssj]

[ابو البشر]

جرب استخدم هذا .......................

Function ClearClipboardData_clt() As Boolean
On Error GoTo err_ClearClipboardData_clt
  Dim lngTemp As Long
  
'  If clt_OpenClipboard(0&) <> 0 Then
'    lngTemp = clt_EmptyClipBoard()
'    lngTemp = clt_CloseClipboard()
'  End If

  ClearClipboardData_clt = True

exit_ClearClipboardData_clt:
  Exit Function

err_ClearClipboardData_clt:
  ClearClipboardData_clt = False
  Resume exit_ClearClipboardData_clt

End Function

 

[nssj]

أصبح الآن يعمل لكن كما كان الأمر أول مرة .. يعمل حتى لو لم يتم تحديد شيء، وأيضاً لا زال مفتاح (Num Lock) يتغير أحيانا مع الكود .. وبعد مرور بعض الوقت برنامج الأكسس يتوقف ولا بد من إجباره على الإغلاق وإعادة تشغيله

[kanory]

الحقيقة اخي لا اعلم ما المشكلة لديك ...

جرب المرفق على اجهزة اخرى ... جتى نعلم هل المشكلة من جهازك ام ماذا ؟؟

[nssj]

6 ساعات مضت, kanory said:

جرب المرفق على اجهزة اخرى ... جتى نعلم هل المشكلة من جهازك ام ماذا ؟؟

جربت الملفات على جهازين غير جهازي، واحد منهم نفس الوندوز (10) لكن أوفس (2010) والثاني وندوز (7) وأوفس (2010)

والنتيجة أحسن بخصوص الملف الأول في مشاركتك الأولى (Book2) لم تظهر الحروف (v) (c) في الجهازين وكان يظهر الكلام المطلوب قصه .. لكن نفس الملاحظة بخصوص تأثر مفتاح (NumLock)

أما الملفات اللي بعده فالنتيجة نفسها .. ظهرت الرسالتين في الجهازين .. وأيضاً لما طبقت اقتراح الأخ ابو البشر النتيجة نفسها على كل الأجهزة: ما في مشكلة بالقص واللصق .. القضية بتأثر مفتاح (NumLock) وإن الكود يعمل حتى لو لم يتم تحديد أي شيء