كل الانشطه

الحمد لله هذا هو المطلوب تماما ... الف شكر لسيادتكم دائما أنتم صاحب فضل وكرم

اختصاراً لوقتك و وقت الاساتذة ، لم لا تقوم بالافاق الملف .

البرنامج قديم جدا وليس من تصميمي وليس عليه حماية برقم سري لاكن يبدو ان المصمم وضع شي يمنع الحفظ عند التعديل

تفضل أخي الفاضل المرفق ملحوظة : أنا محتاج تقرير الصف الأول والثاني والثالث فصل دراسي ثاني فقط اسم تقرير الصف الأو والثاني rep_shhada_olla اسم تقرير الصف الثالث rep_shhada_3 اسم تقرير التحريري ( درجة 1 ) زي اللي حضرتك عملته بس بمعيار ( درجة1 = 0 ) يعني اللي حصل علي 0 اللي احنا بنترجمهم ( غ) rep_Drjat1 Data18.rar

تفضل أخي بناء على نفس الفكرة السابقة أرفق لك ملف يحتوي على كودين: الكود الأول: إنشاء مجلدات وملفات بصيغة xlsb للتجربة تم تعديل الكود بحيث يمكنك: 1) اختيار البارتيشن الذي تريد إنشاء الملفات فيه 2) تحديد عدد المجلدات التي سيتم إنشاؤها 3) تحديد عدد الملفات داخل كل مجلد حسب حاجتك الكود الثاني: تحويل جميع ملفات xlsb في البارتيشن المحدد الكود يقوم بـالبحث داخل البارتيشن الذي تحدده وتحويل جميع الملفات ذات الامتداد xlsb إلى صيغة أخرى xlsx داخل البارتشن المحدد حتى وإن كانت مخزنة داخل مجلدات فرعية متداخلة Option Explicit Sub Convertfiles() Dim dl As Object, n As String, ky As String Dim files() As String, i As Long, a As Long Dim startTime As Double, confirm As VbMsgBoxResult n = "F:\" ' لا تنسى تعديل إسم البارتيشن بما يناسبك confirm = MsgBox("سيتم تحويل جميع الملفات بصيغة xlsb إلى xlsx" & vbCrLf & _ "هل تريد المتابعة؟", vbYesNo + vbQuestion, n & " " & "محرك الأقراص") If confirm <> vbYes Then Exit Sub Set dl = CreateObject("Scripting.FileSystemObject") startTime = Timer SupApp True ky = tMps(dl, n) If Trim(ky) = "" Then MsgBox "xlsb" & " " & "لم يتم العثور على أي ملفات بصيغة ", vbInformation GoTo Cleanup End If files = Split(ky, vbCrLf) a = 0 For i = LBound(files) To UBound(files) If Trim(files(i)) <> "" Then If CntFiles(Trim(files(i)), dl) Then a = a + 1 End If End If Next i MsgBox "تم تحويل" & a & " ملف بنجاح" & vbCrLf & _ "استغرق التنفيذ " & Format(Timer - startTime, "0.00") & " ثانية", vbInformation Cleanup: SupApp False End Sub Function CntFiles(filePath As String, dl As Object) As Boolean Dim wb As Workbook Dim newPath As String On Error GoTo ClearApp Set wb = Workbooks.Open(filePath, ReadOnly:=False) newPath = Replace(filePath, ".xlsb", ".xlsx") wb.SaveAs fileName:=newPath, FileFormat:=xlOpenXMLWorkbook wb.Close SaveChanges:=False If dl.FileExists(newPath) Then dl.DeleteFile filePath, True CntFiles = True End If Exit Function ClearApp: CntFiles = False If Not wb Is Nothing Then wb.Close SaveChanges:=False End Function Function tMps(dl As Object, n As String) As String Dim root As Object, list As Collection, item As Variant, result As String On Error Resume Next Set root = dl.GetFolder(n) If root Is Nothing Then Exit Function On Error GoTo 0 Set list = New Collection Call ScanFiles(dl, root, list) For Each item In list result = result & item & vbCrLf Next item tMps = result End Function Sub ScanFiles(dl As Object, folder As Object, ByRef list As Collection) Dim file As Object, subFolder As Object, fName As String fName = LCase(folder.Path) If InStr(fName, "$recycle.bin") > 0 Then Exit Sub If InStr(fName, "system volume information") > 0 Then Exit Sub For Each file In folder.files If LCase(dl.GetExtensionName(file.Name)) = "xlsb" Then list.Add file.Path End If Next For Each subFolder In folder.SubFolders ScanFiles dl, subFolder, list Next End Sub TEST4.xlsm

حاضر أخي الفاضل

اعمل التقارير كما تحب .. ثم ارفع المثال حتى نربط المصدر

كيف ؟ قلبت هندي 🙃 على كل حال وبدون اي تعديلات تفضلي حسب طلبك فقط حذفت الحقل المحسوب في الجدول ونقلته الى الاستعلام علما انه يوجد اخطاء في تسمية حقول باسماء محجوزة في اكسس مثل كلمة Date databasebalance2.rar

أسأل الله العظيم رب العرش العظيم أن يشفيه شفاء لا يغادر سقما آمين وجميع مرضى المسلمين

أخي الفاضل ( ابو خليل ) بعد سلام الله عليكم ورحمة الله وبركاته أنا تعبتك كثيرا معي ولكن أنا أطمع في حاجتين وطبعا أهل الكرم والجود لا ينضب كرمهم وجودهم *محتاج تقرير تحريري ( درجة 1 ) زي اللي حضرتك عملته بس بمعيار ( درجة1 = 0 ) يعني اللي حصل علي 0 اللي احنا بنترجمهم ( غ ) * شهادة للصفوف الأولي تخص المواد بتاعتهم فقط وكمان من غير درجة الحضور - وكمان شهادة للصف الثالث تخص نفس المواد من غير حضور لأن أصلا ليس لديهم درجة حضور. شكرا جزيلا لحضرتك.

ممكن توضيح اكثر هل البرنامج من تصميمك ام على البرنامج حماية وايش المقصودتعديل بيانات ونماذج واذا امكن مرفق للنظر والتامل فيه

@Foksh اين هو ها المشروع

السلام عليكم ورحمة الله وبركاته فى الموضوع السابق تم عمل كود عن طريق اخى محمد هشام واخى عبدالله يمكنى من حذف ملفات اكسيل ذات امتداد معين ونقله الى فولدر فى السى واليوم اطلب نفس الطريقة ولكن لتحويل الامتداد .xlsb الى .xlsx كل الشكر للمشرفين والخبراء فى هذا المنتدى الحبيب

شكرا جزيلا أخي الفاضل وبارك الله فيك

هذا جزء من مشروع سابق ، ويظهر تقريباً الفكرة ذاتها ، ولكن مع تأسيس مضبوط لمتطلبات الفكرة .. طبعاً التنفيذ تم على جميع الأجزاء التي يتم فيها الدفع ( دائن / مدين ) ... للأفراد أو الشركات ..

هذا حساب عميل يظهر الرصيد حاصل طرح السحب و الايداع انا اوريد كل ما تم ادخال عملية سوا سحب او ايداع يظهر الرصيد بصورة تراكمية مثل الصورة رقم 2

كيف ذلك @ابوخليل 🤔 انا نفر مسكين ما يعرف 😞

إللهم أذهب البأس ربّ النّاس، اشف وأنت الشّافي، لا شفاء إلا شفاؤك، شفاءً لا يغادر سقماً، أذهب البأس ربّ النّاس، بيدك الشّفاء، لا كاشف له إلّا أنت يارب العالمين

عطب عند فتح بالجهاز الي فيه ونداوز 10 حسنا ساحاول رفعه استاذي

الامر بيدك ان اردت مساعدتنا ، وذلك بإرفاق الملف الذي يعمل.

نعم أخي الكريم ، تستطيع استخلاص اليوم والشهر والسنة بشكل منفصل بأكثر من طريقة ، بالإعتماد على حقل الرقم القومي :- السنة لوحدها = YearPart: IIf(Left([Stucard],1)="3",2000,1900)+Val(Mid([Stucard],2,2)) الشهر لوحده = MonthPart: Val(Mid([Stucard],4,2)) اليوم لوحده = DayPart: Val(Mid([Stucard],6,2))

أخي الفاضل (أبو خليل) بارك الله فيك وأكثر الله من أمثالك علي مجهودكم الرائع وربنا يجعله في ميزان حسناتك

شكرا أخي الفاضل علي هذه الملحوظة هذا خطأ مني لأني حذفت من جدول الأسماء وبقيت علي 10 ونسيت احذف من جدول الدرجات . وطبقت الدالة لديك علي الاستعلام وشغالة تمام هل ينفع استخرج السنة لوحدها والأيام والشهور في نفس الاستعلام ؟

تم فحص الملف لدي انظر .............. معطوب

هذه النسخة ايضا بها نفس المشكلة وينداوز2010.rar