اذهب الي المحتوي
أوفيسنا

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


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

السلام عليكم

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

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

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

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

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

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

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

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

تحياتى

تم تعديل بواسطه أم روان المصرية
رابط هذا التعليق
شارك

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

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

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

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

 

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

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

 

رابط هذا التعليق
شارك

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

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

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

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

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

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

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

تحياتى

رابط هذا التعليق
شارك

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

تفيد المصفوفات في حالة التعامل مع البياانات هائلة الحجم .. أما هنا فالحلقات التكرارية ستكون لأوراق العمل من 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

 

تم تعديل بواسطه أبو محمد الأمين
رابط هذا التعليق
شارك

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 ولنغير وقت الحذف بالحادية عشرا مساء كل يوم بإستثناء يوم الجمعة

تحياتى 

تم تعديل بواسطه أم روان المصرية
رابط هذا التعليق
شارك

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

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

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

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

رابط هذا التعليق
شارك

السلام عليكم

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

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

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

اخى ياسر

السلام عليكم

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

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

تحياتى

رابط هذا التعليق
شارك

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

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

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

بهذا السطر

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

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

رابط هذا التعليق
شارك

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

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

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

رابط هذا التعليق
شارك

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.

×
×
  • اضف...

Important Information