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

[أم روان المصرية]

السلام عليكم

تحياتى للجميع 

دى اول مشاركة بمنتداكم المتميز

أبحث عن كود لحذف نطاق ثابت بعدة اوراق بحيث تُحذف هذة النطاقات

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

هذة النطاقات من A8  الى أخر صف بالعمودD  

ومن الشيت السادس وحتى الشيت السادس عشر 

المثال المرفق

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

تحياتى

تم تعديل أبريل 28, 2016 بواسطه أم روان المصرية

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

أختي الفاضلة أم روان

أهلاُ بك في المنتدى ونورتي المنتدى

هل تقصدين بالحذف مسح النطاق لأن اللفظ يختلف فالحذف غير المسح ..

عموماً ليست هذه المشكلة .. يمكن عمل حلقة تكرارية لجميع الأوراق المطلوبة ومسح النطاق ..

 

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

إن شاء الله إذا تيسر لي الوقت سأقوم بمحاولة العمل على الملف

 

[أم روان المصرية]

اخى الفاضل أبو البراء

حضرتك اللى منور الدنيا كلها

شاكرة جدا جدا لحضرتك

فضلت أن يكون الموضوع هنا لتدخل خبراء المنتدى

مسح أم حذف مش دى المشكلة 

المشكلة فى أننى لاأحبذ استخدام الحلقات التكرارية  

فهل يمكن معالجة الموضوع بإستخدام المصفوفات 

تحياتى

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

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

تفيد المصفوفات في حالة التعامل مع البياانات هائلة الحجم .. أما هنا فالحلقات التكرارية ستكون لأوراق العمل من 6 إلى 16

بشكل مبدئي هذا الكود لمسح النطاق في الأوراق المحددة

Sub Test()
    Dim I As Long
    
    For I = 6 To 16
        Worksheets(I).Range("A7").CurrentRegion.Offset(1).ClearContents
    Next I
    
    MsgBox "Done...", 64
End Sub

يوضع الكود في موديول عادي

 

والكود التالي يوضع في حدث المصنف

Private Sub Workbook_Open()
    Dim DayOfWeek As Integer
    
    DayOfWeek = Weekday(DateValue(Date), vbSunday)
    
    If DayOfWeek <> vbFriday Then
        MsgBox "Data In Specific Sheets Will Be Cleared At 12:00 PM", 64
        Application.OnTime TimeValue("12:00:00 PM"), "Test"
    End If
End Sub

 

[أبو حنــــين]

السلام عليكم

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

Sub sDel_ALL()

Dim sH As Worksheet, i As Byte, L As Long

For i = 6 To 16
Set sH = Sheets(i)
With sH
    L = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    If Not Format(Date, "dddd") = vbFriday Then
    If Format(Now, "hh-mm-ss") = TimeSerial(0, 0, 0) Then
    sH.Range("A8:D" & L).ClearContents
    End If
    End If
    End With
    
Next

End Sub

 

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

أخ الغالي أبو حنين

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

أما أن يوضع في موديول فلن يتم التنفيذ بشكل تلقائي ..إذا لابد من تنفيذ الكود في الوقت المحدد بالضبط

 

راجع الكود الذي أرفقته في مشاركتي السابقة وغير الوقت إلى 2:16 مثلاً واحفظ المصنف وفنحه مرة أخرى .. عند التوقيت المحدد سيتم تنفيذ الكود

 

[أبو حنــــين]

وجدت خطأ في الكود الذي أدرجته آنفا

لا نضع يساوي بل نضع أكبر أو يساوي

ثانيا من الأحسن يكون في الحدث BeforeClose

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim sH As Worksheet, i As Byte, L As Long

For i = 6 To 16
Set sH = Sheets(i)
With sH
    L = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
    If Not Format(Date, "dddd") = vbFriday Then
    If Format(Now, "hh-mm-ss") >= TimeSerial(0, 0, 0) Then
    sH.Range("A8:D" & L).ClearContents
    End If
    End If
    End With
    
Next

End Sub

 

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

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

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

تقبل وافر تقديري واحترامي

[أبو حنــــين]

السلام عليكم

قمت بتعديل آخر عند الفتح و الإغلاق

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
    Dim sH As Worksheet, i As Byte, L As Long, Re As String
    If Not Format(Date, "dddd") = vbFriday And Hour(Now()) >= "00" And Minute(Now()) >= "00" Then GoTo 1
    If Not Format(Date, "dddd") = vbFriday And Hour(Now()) <= "00" Then
    Re = MsgBox("لم يتم حذف البيانات لحد الآن و الساعة لم تصل إلى منتصف الليل ، هل تريد القيام بذلك الآن", _
    vbInformation + vbYesNo, "حذف")
    
    If Re = vbNo Then
    ThisWorkbook.Save
    Exit Sub
    Else
    GoTo 2
    End If
    End If
                                                               
1
    If MsgBox("هل تريد حذف جميع البيانات الموجودة في 10 صفحات", vbInformation + vbYesNo, "حذف") = vbNo Then Exit Sub
  
'----------------------------
2
    For i = 6 To 16
    Set sH = Sheets(i)
    With sH
    .Range("A8:D" & .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row).ClearContents
    End With
    Next
  ThisWorkbook.Save   
End Sub

Private Sub Workbook_Open()

    Dim sH As Worksheet, i As Byte, L As Long, Re As String
    If Not Format(Date, "dddd") = vbFriday And Hour(Now()) <= "00" Then
    Re = MsgBox("لا تنسى أن تحذف البيانات قبل منتصف الليل ، هل تود القيام بذلك الآن", _
    vbInformation + vbYesNo, "حذف")
    If Re = vbNo Then Exit Sub
    End If
'----------------------------
    For i = 6 To 16
    Set sH = Sheets(i)
    With sH
    .Range("A8:D" & .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row).ClearContents
    End With
    Next

End Sub

 

تم تعديل أبريل 28, 2016 بواسطه أبو محمد الأمين

[أم روان المصرية]

9 ساعات مضت, ياسر خليل أبو البراء said:

أخ الغالي أبو حنين

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

أما أن يوضع في موديول فلن يتم التنفيذ بشكل تلقائي ..إذا لابد من تنفيذ الكود في الوقت المحدد بالضبط

راجع الكود الذي أرفقته في مشاركتي السابقة وغير الوقت إلى 2:16 مثلاً واحفظ المصنف وفنحه مرة أخرى .. عند التوقيت المحدد سيتم تنفيذ الكود

 

اخى ابو البراء

السلام عليكم

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

        Worksheets(I).Range("A7").CurrentRegion.Offset(1).ClearContents

تحياتى

[أم روان المصرية]

8 ساعات مضت, أبو محمد الأمين said:

السلام عليكم

قمت بتعديل آخر عند الفتح و الإغلاق

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
    Dim sH As Worksheet, i As Byte, L As Long, Re As String
    If Not Format(Date, "dddd") = vbFriday And Hour(Now()) >= "00" And Minute(Now()) >= "00" Then GoTo 1
    If Not Format(Date, "dddd") = vbFriday And Hour(Now()) <= "00" Then
    Re = MsgBox("لم يتم حذف البيانات لحد الآن و الساعة لم تصل إلى منتصف الليل ، هل تريد القيام بذلك الآن", _
    vbInformation + vbYesNo, "حذف")
    
    If Re = vbNo Then
    ThisWorkbook.Save
    Exit Sub
    Else
    GoTo 2
    End If
    End If
                                                               
1
    If MsgBox("هل تريد حذف جميع البيانات الموجودة في 10 صفحات", vbInformation + vbYesNo, "حذف") = vbNo Then Exit Sub
  
'----------------------------
2
    For i = 6 To 16
    Set sH = Sheets(i)
    With sH
    .Range("A8:D" & .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row).ClearContents
    End With
    Next
  ThisWorkbook.Save   
End Sub

Private Sub Workbook_Open()

    Dim sH As Worksheet, i As Byte, L As Long, Re As String
    If Not Format(Date, "dddd") = vbFriday And Hour(Now()) <= "00" Then
    Re = MsgBox("لا تنسى أن تحذف البيانات قبل منتصف الليل ، هل تود القيام بذلك الآن", _
    vbInformation + vbYesNo, "حذف")
    If Re = vbNo Then Exit Sub
    End If
'----------------------------
    For i = 6 To 16
    Set sH = Sheets(i)
    With sH
    .Range("A8:D" & .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row).ClearContents
    End With
    Next

End Sub

 

السيد الاستاذ / ابو محمد الامين

السلام عليكم

شاكرة جدا جدا اهتمام حضرتك

مع تغيير ساعة الجهاز الى 11:57 م  والانتظار لمدة ثلاثة دقائق 

لوحظ تغيير الساعة الى 1:00 ص بدلا من الساعة 12:00 ولن يتم تنفيذ المطلوب

أعتقد أن الحل أصبح قريب واقترح الاتى 

اضافة أمر معاينة وطباعة لشيت رقم 16 ثم بعد ذلك تحذف جميع النطاقات من

شيت رقم 6 الى شيت رقم 16 ولنغير وقت الحذف بالحادية عشرا مساء كل يوم بإستثناء يوم الجمعة

تحياتى 

تم تعديل أبريل 28, 2016 بواسطه أم روان المصرية

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

أختي الفاضلة أم روان

في ملفك قومي بإزالة الدمج من الصف الذي يحتوي على العناوين ..إذ أن الدمج عدو الأكواد ..

أنا جربت على ملف من عندي وأزلت الدمج قبل التجربة ، وكان يجب أن أنوه لذلك الأمر

والنقطة التي يجب التركيز عليها ليست مسح النطاق كما ذكرتي إنما تنفيذ الكود في وقت محدد في أيام محددة ، وقد قدمته في مشاركتي في حدث فتح المصنف ..فيمكنك عمل إجراء فرعي لإظهار رسالة مثلاً وضعي الكود في حدث المصنف المسئول عن التوقيت وجربي بنفسك ..

[أبو حنــــين]

السلام عليكم

قمت بهذه المحاولة و اعتقد انها تعمل حيث غيرت في ساعة و يوم الحاسوب

حذف نطاق ثابت بعدة اوراق بتوقيت ثابت من كل يوم بإستثناء يوم 2الجمعه.rar

[أم روان المصرية]

في 4/27/2016 at 01:44, ياسر خليل أبو البراء said:

أختي الفاضلة أم روان

في ملفك قومي بإزالة الدمج من الصف الذي يحتوي على العناوين ..إذ أن الدمج عدو الأكواد ..

أنا جربت على ملف من عندي وأزلت الدمج قبل التجربة ، وكان يجب أن أنوه لذلك الأمر

والنقطة التي يجب التركيز عليها ليست مسح النطاق كما ذكرتي إنما تنفيذ الكود في وقت محدد في أيام محددة ، وقد قدمته في مشاركتي في حدث فتح المصنف ..فيمكنك عمل إجراء فرعي لإظهار رسالة مثلاً وضعي الكود في حدث المصنف المسئول عن التوقيت وجربي بنفسك ..

اخى ياسر

السلام عليكم

اعتقد أن دمج العناوين مطلوب 

فهل من محاولة أخرى لتجنب رسالة الخطأ

تحياتى

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

وعليكم السلام

يمكن استبدال السطر التالي

 Worksheets(I).Range("A7").CurrentRegion.Offset(1).ClearContents

بهذا السطر

 Worksheets(I).Range("A8:ِ10000").ClearContents

حيث A8 يمثل أول خلية بعد صف العنوان .. لم أطلع على الملف أنا أعمل بشكل عام

[أم روان المصرية]

السلام عليكم

أشكركم لحسن تعاونكم 

تحياتى

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

وعليكم السلام

نفهم من المشاركة الأخيرة أن الموضوع تم على خير والحمد لله

الحمد لله الذي بنعمته تتم الصالحات

[أم روان المصرية]

أخى ابو البراء

وعليكم السلام

نعم تم الموضوع على خير والحمد لله

والحمد لله الذي بنعمته تتم الصالحات

تحياتى