مختار حسين محمود

وأنت فاتح ملف الاكسل اضغط  المفتاحين  Alt  + F11   معا هتلاقى نافذة محرر الاكواد 
من فوق هتلاقى قوائم من ضمنها قائمة insert  اختر  مديول  هتفتح معاك صفحة بيضاء
هذه الصفحة هى نافذة محرر الاكواد  بنكتب و نلصق فيها الاكواد 
جرب الملف ده   هتلاقى جواه  كود حفظ الشيت كملف جديد 
بيان وقتى 2.rar

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

أخى الحبيب على جرب الكوداية دى
Sub mokhtest() ActiveCell.Copy Sheets("مستودع").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) End Sub معنى الكود انسخ الخلية النشطة والصق فى أول خلية فارغة بالعمود 1 بورقة العمل مستودع  بس خلاص
حدد الخلية واضغط الزر هتلاقيها فى الشيت مستودع ولو حبيت تضيف خلايا أخرى براحتك  تحياتى

أخى الحبيب حمل المرفق التالى
بعد فك الضغط  هتلاقى ملف اكسل ضع ملف الاكسل فى المسار بتاعك
C:\Program Files (x86)\Microsoft Office\Office14\XLSTART
داخل مجلد XLSTART   
افتح أى ملف الاكسل  وافتح الفيجوال بيسك  هتلاقى فيه كود hide_toolbar  هو اللى أنا وضعته فى الملف test
افتح ملف اكسل تانى وافتح الفيجوال بيسك  هتلاقى فيه الكود  hide_toolbar  أيضا
وهكذا يمكن أن نقول على الكود ده دائم لأنك ممكن تستعمله مع أى ملف  أرجو أن تكون فهمتنى  تحياتى
 
TEST.rar

كل سنة وأنت طيب يا أبا بهاء
الطلب الأول :
للتعبئة والمسح  :استخدم الكودين التاليين :
Sub GenerateRandom() Range("A10:A210").FormulaR1C1 = "=RANDBETWEEN(1,12)" End Sub Sub DEL() Range("A10:A210") = "" End Sub تحياتى

أعتقد أن هذا هو الكود النهائى يا أبا حنين
الكود ينتج عنه ملف PDF واحد ويحتوى  على النطاقات التى تحوى كلمة  printing  فقط  وبدون تكرار النطاقات
Sub SaveAsPDFB2CONFinal() Dim fName As String, i As Integer Dim AWS As Worksheet, RWS As Worksheet, ws As Worksheet Application.DisplayAlerts = False Application.ScreenUpdating = False Set AWS = ActiveSheet Set RWS = Worksheets.Add(After:=Sheets(Worksheets.Count)) fName = "D:\" & Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range("D5").Value & ".pdf" For Each ws In Worksheets With ws If .Range("A1").Value = "printing" Then .Range("A1:F20").Copy RWS.Range("A" & RWS.Rows.Count).End(xlUp).Offset(1) End With Next ws RWS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False RWS.Delete AWS.Activate Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub تفضل المرفق
PDF Based 2 Condition Final .rar

كود اختيار أكثر من ملف للحذف دفعة واحدة
Sub FilesChosentobedel() Dim strPath As String Dim FilesChosen As Integer, X As Integer FilesChosen = Application.FileDialog(msoFileDialogOpen).Show If FilesChosen <> 0 Then For X = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.Count strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(X) Kill strPath Next X End If End Sub فى الصندوق الحوارى  حدد الملفات المراد حذفها واضغط open
=====================================
 
الملفات  قيد التشغيل لا يمكن حذفها ولا يمكن اعادة تسميتها أو نقلها
 
أما بخصوص الجزئية  :
"لانه كثيرا ما يعلق عندنا ملفات على الرغم اننا لا نستخدمها الا أن الويندوز يراها تحت التشغيل ولهذا لا يقبل حذفها او تعديل اسمها !!! "
 
مش فاهم قصدك بالملفات العالقة ولكن يمكن أن أقول أن TASK MANAGER  أو اعادة تشغيل الجهاز يكفى لغلق الملفات اذا كان الجهاز مريح أو مهنج 
 
تحياتى

الطريقة باختصار :
يمكن عمل ذلك من خلال فتح الملف الذى به شاشة الدخول ثم فتح الفيجوال بيزك
ومن قائمة file  اعمل تصدير للفورم الذى به شاشة الدخول   كيف ؟
حدده ومن Export file  احفظه الى مكان تعرفه على جهازك
ثم افتح الملف الجديد ثم فتح الفيجوال بيزك  واعمل استيراد للفورم كيف؟
من قائمة file  اختر Import file   روح  على نفس المكان الذى حفظت  فيه الفورم  واستورده
بعد عمل ذلك ستجد الفورم بقى فى الملف الجديد .
ولا تنسى نسخ كود استدعاء الفورم من حدث المصنف الذى به شاشة الدخول الى ملف البيانات.وتحفظ
 
 لو معرفتش أرفق  الملفين  تحياتى

أخى الكريم  لم أجرب الكود كما ينبغى ولم أدقق فى النتائج  معذرة
Option Explicit Sub FilterDataCopyTo()       Dim WS As Worksheet     Dim myDate As Date          Set WS = Sheets("ادخال بيانات")         Application.ScreenUpdating = False     Application.DisplayAlerts = False     With WS         .AutoFilterMode = False         .Range("A7:S7").AutoFilter Field:=12, Criteria1:="=محول إلى المدرسة", Operator:=xlOr, Criteria2:="="         .UsedRange.Offset(8).SpecialCells(xlCellTypeVisible).Copy     End With         Sheets("السجل").Activate     Range("A8").Select     Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False    Sheets("ادخال بيانات").Select     Selection.AutoFilter            Application.CutCopyMode = False    Application.ScreenUpdating = True    Application.DisplayAlerts = True    MsgBox ("المهمة انتهت بنجاج") End Sub تحياتى

على فكرة  يا أبوصلاح أخوك مش ناسيك  كنت فى بالى وأنا مريح من عناء الاكسل النهردة  الصبحية
 كوداية صغيرة فى حدث المصنف زى دى
Private Sub Workbook_Open() AlertTime = Now + TimeValue("00:00:10") Application.OnTime AlertTime, "autosave" End Sub وحنة صغيرة فى مديول عادى زى دى
Sub autosave() Application.ScreenUpdating = False Application.DisplayAlerts = False ThisWorkbook.Save AlertTime = Now + TimeValue("00:00:10") Application.OnTime AlertTime, "autosave" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub الأثنين بيعملو حفظ تلقائى كل 10 ثوانى من غير ما تشعر   تحياتى

تفضل  أخى عبدووووووووو
recharche XD 1 v2.rar
recharche XD 2 v2.rar

تفضل أخى الكريم
تفقيط رائع للدرجات الصحيحة ونصف الدرجة  لأى عدد ولكن بدون الصفر  قد يفيدك
 
كان الله فى العون    تحياتى أخوك مختار حسين
تفقط رائع للدرجات الصحيحة ونصف الدرجة.rar

تفضل أخى الكريم
اعمل أى فلترة هتلاقى التسلسل تلقائى
ان أعجبك اختر الاجابه كأفضل اجابة
للتسلسل التلقائى بعدالفلترة.rar

السلام عليكم
تفضل المرفق التالى  ( طباعة  أستاذ بكل صفحة )
 
اكتب فى الخلية   q5   و q6  العدد الذى تريده من الأستاذه  ثم اضغط الزر
xxxxxxxxxxxxxxxxx.rar