التخلص من صناديق النصوص Text Boxes في ورقة العمل النشطة

[ياسين ( أبو وسام )]

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

 

اسعد الله مسائكم اعضاء منتدانا الغالي

 

لدي في مشكلة في اكسل عم الضغط على اي خانة في الملف يظهر مربع حوار غريب بدون طلب اضافته

 

 

ارجو المساعدة.

 

مرفق نموذج

 

Draft.rar

[ياسر خليل أبو البراء]

أخي الكريم ياسين

يوجد عدد كبير جداً من صناديق النصوص Textboxes .. هل تم نسخ البيانات في ورقة العمل من مكان آخر أم كيف تم إدراج كل هذا العدد من صناديق النصوص؟

[ياسر خليل أبو البراء]

الأخ الفاضل ياسين أبو وسام

جرب الملف التالي ..

حاولت أن أقوم بتنفيذ أكواد تقوم بحذف صناديق النصوص الموجودة في ورقة العمل إلا أنه يبدو أن هناك عدد كبير منها ولذا استغرق الكود وقت طويل جداً

فقمت بالتحايل وقمت بنسخ ورقة العمل التي بها هذا العدد الكبير من صناديق النصوص ، وعملية النسخ تستثني الأشكال ..

Sub CopySheetWithoutShapes()
'يقوم الكود بنسخ ورقة العمل بدون أي أشكال ويحذف ورقة العمل ثم يقوم بتسمية ورقة العمل الجديدة بنفس الاسم القديم
    Dim strName As String
    Application.CopyObjectsWithCells = False
    Application.DisplayAlerts = False
        strName = "000"
        With ThisWorkbook.Sheets(strName)
            .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            .Delete
        End With
        ActiveSheet.Name = strName
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True
End Sub

أرجو أن يؤدي الغرض ويحل المشكلة

 

في الملف المرفق لم يتم تنفيذ الكود لتقوم بتنفيذه بنفسك .. قبل التنفيذ لاحظ مشكلتك ما زالت قائمة

قم بالضغط على مفتاحي Alt + F11 ثم اختار اسم الماكرو المراد تنفيذه CopySheetWithoutShapes ثم أخيرا انقر RUN

Draft.rar

[ياسين ( أبو وسام )]

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

يعطيك العافيه على متابعة الموضوع اخي ابو البراء

انا نفسي اعرف من فين عما تظهر مربع النص عند الضغط ع الماوس هل هوا فيروس ما اظن او خلل في اعدادات الماوس في اكسل

على العموم سوف احاول استخدام الكود وافادتكم في النتائج ان شاءالله

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

شاكر ومقدر مجهودكم

وتقبل تحياتي

[ياسر خليل أبو البراء]

أخي لا أعتقد أنه فيروس

ربما تقوم بعملية نسخ لورقة العمل تلك ومن الطبيعي أن النسخ العادي سيقوم بنسخ ورقة العمل تماماً كما هي ، فتصبح الجديدة مثل ورقة العمل القديمة بما في ذلك الأخطاء الموجودة

عموماً هذا كود آخر يمكنك من خلاله التخلص من كل صناديق النصوص في ورقة العمل النشطة

Sub DeleteAllTextBoxes()
'يقوم الكود بحذف كل صناديق النصوص في ورقة العمل النشطة
    ActiveSheet.TextBoxes.Delete
End Sub

تقبل تحياتي

[ياسين ( أبو وسام )]

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

تم تطبيق الكود وبالفعل قام بحذف كافة التول بوكس الموجود في الشيت 

بوركت اخي أبو البراء على المساعدة وجزاك الله خيرا 

ولكم تحياتي

[ياسر خليل أبو البراء]

الحمد لله أن تم المطلوب على خير أخي الكريم ياسين

ومشكور على تحديد أفضل إجابة

تقبل تحياتي