ارجو كود مسح محتويات جدول

[roushdy]

ارجو كود او مكرو يقوم بمسح محتويات جدول

[بن علية حاجي]

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

أخي الكريم، دون مثال (ملف مرفق) على ما تطلب يصعب التعامل مع هذا الطلب... يمكنك استعمال الكودالتالي (وهنايمكنك التغيير فيه وخاصة في المدى الذي تريد مسحه):

Sub ClearCells()

    Range("B4:E13").Select

    Selection.SpecialCells(xlCellTypeConstants, 23).Select

    Selection.ClearContents

    Range("A1").Select

End Sub

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

والله أعلم

تم تعديل مارس 18, 2010 بواسطه hben

[roushdy]

اخى الفاضل hben بارك الله فيك

هذا الكود يكفى ولك جزيل الشكر

[أيسم إبراهيم]

السلام عليكم

أخي الكريم بن علية

جزاك الله خيرا على الكود الجميل

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

Sub Button1_Click()

prompt = "هل تريد مسح البيانات؟انتبه لا يوجد تراجع عن المسح!!"

Command_buttons = vbYesNo + VbMsgBoxRt1Reading

تحذير ! انتبه"

project = MsgBox(prompt, Command_buttons, Title)

If project = vbYes Then

	Range("B4:E13").Select

	'Selection.SpecialCells(xlCellTypeConstants, 23).Select

	Selection.ClearContents

	Range("A1").Select

End If

End Sub

وهي رسالة تنبيه قبل تنفيذ الكود بها الأمرين " نعم و لا "

دمتم بخير

أيسم إبراهيم

Range.clear.rar

[roushdy]

بارك الله فيك اخى

ولكن عند تنفيذ الماكرو والجدول خالى من البيانات تظهر رسالة خطأفى الكود

كيف يتم معالجة ذلك ؟

[بن علية حاجي]

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

بارك الله فيك أخي الكريم أيسم ابراهيم على هذه الإضافة الجميلة للكود وهذا التنبيه... غير أني لاحظت أنك قمت بإلغاء الأمر :

 Selection.SpecialCells(xlCellTypeConstants, 23).Select

الذي يقوم بمسح مضمون النطاق المحدد دون الصيغ والمعادلات وجعلتَ الكود يمسح كل مضمون الخلايا في النطاق (مع الصيغ)، لهذا قمتُ بتغيير بسيط على الكود ليعمل بشكل أفضل ويتم مسح مضامين الخلايا دون مسح الصيغ التي تحويها... والكود يكون كما يلي:

Sub Button1_Click()

prompt = "هل تريد مسح البيانات؟انتبه لا يوجد تراجع عن المسح!!"

Command_buttons = vbYesNo + VbMsgBoxRt1Reading

تحذير ! انتبه"

project = MsgBox(prompt, Command_buttons, Title)

If project = vbYes Then

	Range("B4:E13").Select

        On Error GoTo 1

	Selection.SpecialCells(xlCellTypeConstants, 23).Select

        Selection.ClearContents

        1:

	Range("A1").Select


End If

End Sub

أخوكم بن علية

تم تعديل مارس 19, 2010 بواسطه hben

[بن علية حاجي]

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

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

بارك الله فيك اخى

ولكن عند تنفيذ الماكرو والجدول خالى من البيانات تظهر رسالة خطأفى الكود

كيف يتم معالجة ذلك ؟

[roushdy]

الف شكر

[zoom10]

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

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

[zoom10]

-------------up-----------

[jawad80]

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

بارك الله فيك أخي الكريم أيسم ابراهيم على هذه الإضافة الجميلة للكود وهذا التنبيه... غير أني لاحظت أنك قمت بإلغاء الأمر :

 

Selection.SpecialCells(xlCellTypeConstants, 23).Select

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

والكود يكون كما يلي:

Sub Button1_Click()
prompt = "هل تريد مسح البيانات؟انتبه لا يوجد تراجع عن المسح!!"
Command_buttons = vbYesNo + VbMsgBoxRt1Reading
تحذير ! انتبه"
project = MsgBox(prompt, Command_buttons, Title)
If project = vbYes Then
	Range("B4:E13").Select
        On Error GoTo 1
	Selection.SpecialCells(xlCellTypeConstants, 23).Select
        Selection.ClearContents
        1:
	Range("A1").Select

End If
End Sub

أخوكم بن علية

 

السيد بن علية هذا الكود رائع ولكن هل بالامكان تطبيقة على اثنين من الصفحات الصفحة الاولى ضمن الرينج A3:D45 والصفحة الثانية ضمن الرينج D6:U21

[الـعيدروس]

السلام عليكم

 

 

 

السيد بن علية هذا الكود رائع ولكن هل بالامكان تطبيقة على اثنين من الصفحات الصفحة الاولى ضمن الرينج A3:D45 والصفحة الثانية ضمن الرينج D6:U21

 

جرب التعديل التالي

Private Const Rng As String = "D6:U21,A3:D45"
Private Const Sht As String = "ورقة1,ورقة2"
Sub dddd()
prompt = "هل تريد مسح البيانات؟انتبه لا يوجد تراجع عن المسح!!"
Command_buttons = vbYesNo + VbMsgBoxRt1Reading
'تحذير ! انتبه"
project = MsgBox(prompt, Command_buttons, Title)
If project = vbYes Then
   x = Split(Rng, ",")
   xx = Split(Sht, ",")
   For i = LBound(x) To UBound(x)
   On Error GoTo 1
    Sheets(xx(i)).Range(x(i)).SpecialCells(xlCellTypeConstants, 23).ClearContents
1:
   Next
End If
End Sub

[jawad80]

شكراً اخي العزيز بن علية على الرد ولكن الكود لايعمل .ارجوا التعديل علية ولك الشكر الجزيل

[الـعيدروس]

تأكد من تسمية الاوراق في ملفك

 

وعدل في بداية الكود السطر التالي

Private Const Sht As String = "ورقة1,ورقة2" 

[jawad80]

جربت ولم يفلح الامر

[الـعيدروس]

انا جربته سابقاً يعمل بشكل طبيعي

الاوفيس 2007

عموما ارفق مثال وبه الكود 

[jawad80]

اخي العزيز في المرفقات المثال ولك الشكر

مثال2.rar