ابو البشر

اذا كنت مصر على طريقتك تفضل التعديل .... Function Export_Excel_officena_by_aba_judy(sXlsFile As String, sQuery As String, WrSht As Integer) Dim oExcel As Object Dim oExcelWrkBk As Object Dim oExcelWrSht As Object Dim bExcelOpened As Boolean Dim db As DAO.Database Dim rs As DAO.Recordset Dim iCols As Integer Const xlCenter = -4108 On Error Resume Next Set oExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Err.Clear On Error GoTo Error_Handler Set oExcel = CreateObject("excel.application") bExcelOpened = False Else bExcelOpened = True End If On Error GoTo Error_Handler oExcel.ScreenUpdating = False oExcel.Visible = True Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile) DoEvents Set oExcelWrSht = oExcelWrkBk.Sheets(WrSht) oExcelWrSht.Activate Set db = CurrentDb Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot) With rs If .RecordCount <> 0 Then .MoveFirst oExcelWrSht.Range("f2").Value = "List Of New Monthly subscription( K4 )" oExcelWrSht.Range("j2").Value = Format(Date, "mmmm\.yyyy") oExcelWrSht.Range("f6").CopyFromRecordset rs oExcelWrSht.Range("f6").Select oExcelWrSht.Range("f1").Select Else MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with" GoTo Error_Handler_Exit End If End With Error_Handler_Exit: On Error Resume Next oExcel.Visible = True rs.Close Set rs = Nothing Set db = Nothing Set oExcelWrSht = Nothing Set oExcelWrkBk = Nothing oExcel.ScreenUpdating = True Set oExcel = Nothing Exit Function Error_Handler: MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: Export_Excel_officena_by_aba_judy" & vbCrLf & _ "Error Description: " & Err.Description _ , vbOKOnly + vbCritical, "An Error has Occured!" Resume Error_Handler_Exit End Function استدعيها بهذا الشكل في النموذج مع تعديل الرقم حسب رقم الشيت لديك ... Dim sXlsFile As String sXlsFile = CurrentProject.Path & "\K6_Ded.xlsx" Call Export_Excel_officena_by_aba_judy(sXlsFile, "SELECT * FROM qry_Ded_K4_New_Excel", 1) قم بتعديل الرقم 1 الى ارقام الشيت لديك

انا ضعيف جدا في الشرح..... لكن .... ماتم عمله هو ::::: 1- عملنا كمبوبكس وجعلنا مصدر بياناتة جدول الفصول 2- عملنا تقريرين فرعين وكل تقرير مرتبط باستعلام .... احد الاستعلامين ( يتم فيه تصفية اسماء الذكور فقط حسب الفصل المسجل في الكمبوبكس - يتم فيه تصفية اسماء الاناث فقط حسب الفصل المسجل في الكمبوبكس ) 3- جعلنا التقريرين الفرعين في تقرير واحد للعرض ... هذا ماتم عمله بارك الله فيك

تفضل <><><><><><><><> قاعدة بيانات مدرسية.accdb

هي نص .... كيف يكون رقم ...... الناتج ماهو 123456789

هل هذا هو طلبك اخي الكريم ...............

جرب هذا ............. Me.RecordSource = "SELECT TOP " & Me.txtTop & " Query1.العمر, * FROM Query1 ORDER BY Query1.العمر ASC;"

تحتاج اعادة ترتيب للكود ...... وخاصة قاعدة IF

تفضل <><><><><><><><> ملفك بعد التعديل باستخدام نفس الاستعلام لديك .... Exam.accdb

اين اسماء المواد في الجداول ..... ( جدول الامتحان وجدول لجان الامتحان ) ؟؟؟؟؟

انت يبدو لي نسخت الكود من برنامج اخر والصقته دون تعديل بما تريد حاول مسح وتقليص الكود حسب احتياجك انت ...

ماذا تقصد بليس لها علاقة بالتطبيق .... ممكن مثال لهذه العبارات ؟؟

ربما فهمت مطلوبك .... جرب 20231211.accdb

الية العمل غير مفهوم لدي !!!! معليش متى تريد ظهور الرسالة السابقة في اي الحالات ؟؟؟

تقصد ده <<<<<<<<<<<<<<<<<<<<<<

طيب ::::: الاستعلام الاول ::: تم عمله لحصر اسماء الدول المشاركة عن طريق استعلام تجميع الاستعلام الثاني :::: تم عمله لجميع المشاركين من كل دولة في كل فرع من فروع المسابقة ( والسبب لحصر اسم واحد للدولة في كل مشاركة .... لان بعض الدول مشاركة بأكثر من طالب في الفرع الواحد ) بهذا الشكل نحصل على اسم الدولة في الفرع فقط دون تكرار الاستعلام الثالث والاخير :::: تم عمل استعلام تجميع لفروع المسابقة لحصر عدد الدول المشاركة في كل فرع ,,, وهو ما تم ربطه بالنموذج هذه طريفة بدون استعلام ظاهر جعلنا الاستعلامات مخفية في استعلام النموذج ....... Rac.accdb

للاسف عملتها على عجل لكن يبدو لي هناك طرق افضل من هذا <><><><><><><><><> Rac.accdb

طيب اتبع هذه الخطوات .....

باستخدام خاصية البحث في المنتدي ............ هناك العشرات من تصاميم الات الحاسبة بأنواعها واشكالها المختلفة

ويجب ان تكون الصورة بصيفة BMP فقط ...

عن طريق اطار عنصر منضم ...

تفضل استاذي <><><><>

بارك الله فيك اخونا الشباب في فكرك والكبير قدرا .... ممكن الكود الذي اشرت اليه ( الطريقة الثانية ) للعلم والاستفادة ... جزاك الله خيرأ ..... لانه لدي كود واريد ان استفيد من تعدد الطرق ...

طيب جرب ده ...... UPDATE DISTINCTROW (TableX INNER JOIN qy_kan ON TableX.NameX = qy_kan.NameX) LEFT JOIN KindX ON qy_kan.Expr2 = KindX.LikeB SET TableX.NameX = Replace([TableX].[NameX],[LikeA],""), TableX.KindX = [KindX].[LikeB] WHERE (((qy_kan.Expr2)<>""));

؟؟؟؟؟ !!!!!!

ضع داخل زر الحفظ هذه الشيفرة ..... Dim db As DAO.Database Dim rstFrom As Recordset Dim rstTo As Recordset Set db = CurrentDb Dim RC, i, r As Integer Set rstTo = db.OpenRecordset("tbl_add_fasl", dbOpenDynaset) Set rstFrom = db.OpenRecordset("SELECT tbl_saf.id_m, tbl_saf.mr, tbl_saf.id_saf, tbl_saf.saf, tbl_saf.add_fasl FROM tbl_saf WHERE (((tbl_saf.id_m)=" & [Forms]![frm_m_r_f]![cb_mr] & "));", dbOpenDynaset) rstFrom.MoveFirst: rstFrom.MoveLast RC = rstFrom.RecordCount rstFrom.MoveFirst For i = 1 To RC For r = 1 To rstFrom!add_fasl rstTo.AddNew rstTo!id_m = rstFrom!id_m rstTo!mr = rstFrom!mr rstTo!id_saf = rstFrom!id_saf rstTo!saf = rstFrom!saf rstTo!add_fasl = r rstTo.Update Next r rstFrom.MoveNext Next i rstTo.Close rstFrom.Close Set rstTo = Nothing Set rstFrom = Nothing Set db = Nothing