Barna

ما شاء الله تبارك الله تستاهل اخي اللقب ... والى الامام ...

مبدأيا يمكن عمل فكرتك باحدى طريقتين : 1- نجعل الاكسس قبل الالحاق يتأكد سجل سجل ( هل هو موجود او لا ) واعتقد هذه الطريقة تأخذ وقت وخاصة اذا كانت السجلات كثيرة 2- نجعل الاكسس يحصر السجلات الموجود في الجدولين وفي حال وجود مكرر يظهرها لنا في نموذج وسؤالنا هل نريد الحاق هذه الاسماء المكررة ام لا اذا اذا كان ليس هناك تكرار في السجلات يقوم بالحاق السجلات دون اظهار النموذج وقد تكون هناك طرق اخرى .....

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

استخدم هذا الكود Dim fpathz As Variant Dim fil As String With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Clear .Filters.Add "All Files", "*.*" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then fpathz = .SelectedItems(1) End If End With 'DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO tb_redy_rateb ( id_imp, tmonth, tyer, school, tnam, national_iD, old_asis, new_asis, elawa14, elawa15, edafya, egtemaya, hafz25, adaaa, badlteatcher, kader, ekama, shamel, add_nesab1, add_nesab2, add_nesab3, add_nesab4, masthkak, mastktaa, safy ) IN '" & fpathz & "' SELECT * " & vbCrLf & _ "FROM tb_redy_rateb;" 'DoCmd.SetWarnings True

جزاك الله خير ..... شكرا لك

فكرة ممتازة أخي ابا ابراهيم ::::: تشكر

حياك الله اخي الكريم ...... بالتوفيق

حياك الله .... بالتوفيق

جرب الملف --------->> Ba_55.accdb

مصدر مربع النص ضع هذا الكود .... =DLookUp("[SumمنTotalmany]";"q1";"[Deprt]=" & """علوم الحياة""")

نعم صحيح والاستدعاء عن طريق زر ممكن

بعم يمكن ذلك استخدم هذا الكود Private Const TIMEOUT = 99 Public Sub Restart() Dim scriptpath As String scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat" If Dir(scriptpath, vbNormal) <> "" Then If DateAdd("s", TIMEOUT * 1, FileDateTime(scriptpath)) < Date Then Kill scriptpath Else Application.Quit acQuitSaveAll Exit Sub End If End If Dim s As String s = s & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf s = s & "SET /a counter=0" & vbCrLf s = s & ":CHECKLOCKFILE" & vbCrLf s = s & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf s = s & "SET /a counter+=1" & vbCrLf s = s & "IF ""!counter!""==""" & TIMEOUT & """ GOTO CLEANUP" & vbCrLf s = s & "IF EXIST ""%~f1.%3"" GOTO CHECKLOCKFILE" & vbCrLf s = s & "start "" "" ""%~f1.%2""" & vbCrLf s = s & ":CLEANUP" & vbCrLf s = s & "del %0" Dim intFile As Integer intFile = FreeFile() Open scriptpath For Output As #intFile Print #intFile, s Close #intFile Dim dbname As String, ext As String, lockext As String Dim idx As Integer For idx = Len(CurrentProject.FullName) To 1 Step -1 If Mid(CurrentProject.FullName, idx, 1) = "." Then Exit For Next idx dbname = Left(CurrentProject.FullName, idx - 1) ext = Mid(CurrentProject.FullName, idx + 1) If Left(ext, 2) = "ac" Then lockext = "laccdb" Else lockext = "ldb" End If s = """" & scriptpath & """ """ & dbname & """ " & ext & " " & lockext Shell s, vbHide Application.Quit acQuitSaveAll End Sub ثم استدعيه بهذا الكود Private Sub btRestart_Click() Utilities.Restart End Sub

ممكن تزودنا بمثال مصغر للعمل عليه

جرب هذا الكود وعدله كما تشاء If (Time() >= #5:39:00 AM#) Then MsgBox "System Maintenance On-going. Please check back after 3 minutes.", vbOKOnly DoCmd.Quit acQuitSaveAll End If ملاحظة : يمكن للمستخدم ان يتلاعب في وقت الجهاز

طبق ما في الصورة الالتزام بالقائمة ...... نعم السماح بعمليات تحرير قوائم القيم ........ لا

حتى لا يحدث لبس ---------------> تم الاستغناء عن 3 جداول : 1- جدول المواد 2- جدول الشعب 3- جدول الصف والاكتفاء في جلب هذه المعلومات من الجدول الاساسي فقط ........ تم التعديل على هذا الاساس ............ ---------------->>>>>> انظر المرفق برنامج تصدير الطلاب للسجل FFالالكتروني.mdb

انظر المرفق واعلمنا بالنتيجة ---------->>>>>> يقوم البرنامج بنسخ البيانات المطلوبة في ملف باسم الشعبة ويحفظ بجوار البرنامج مباشرة دون الحاجة للحفظ وفي نفس الوقت يحافظ على الملف الاساس للاكسل Ba1_Deffi.rar

طيب دقائق اعدل بعض الاشياء و نجعل البرنامج يحفظ مباشرة في ملف باسم الشعبة .....------------>>>>>>>

حلها بارك الله في تحويل ملف الاكسل الى قالب ...... جرب واعلمنا بالنتيجة ....... اجتماعيات.rar

مشاركة مع حبايبنا الاساتذة .... استخدمن هذا الكود لتصدير العمودين وبعض البيانات لملف الاكسل ..... Dim db1 As DAO.Database Dim Rst1 As DAO.Recordset Set db1 = CurrentDb Dim objExcel As Object Dim objWorkbook As Object Set objExcel = CreateObject("Excel.Application") Set objWorkbook = objExcel.Workbooks.Open(sXlsFile) Set Rst1 = db1.OpenRecordset("temp", dbOpenSnapshot) objWorkbook.Sheets(2).range("H1").Value = "اسماء طلاب الصف " & "(" & [Forms]![FORM2]![مربع_تحرير_وسرد8] & ")" & "الشعبة " & "(" & [Forms]![FORM2]![مربع_تحرير_وسرد12] & ")" With Rst1 If .RecordCount <> 0 Then .MoveFirst objWorkbook.Sheets(2).range("b5").CopyFromRecordset Rst1 objWorkbook.Sheets(2).range("b5").Select End If End With objExcel.DisplayAlerts = True objWorkbook.Close SaveChanges:=True Set objWorkbook = Nothing objExcel.Quit Set objExcel = Nothing Set Rst1 = Nothing Set db1 = Nothing VBA.Shell "Explorer.exe " & Chr(34) & sXlsFile & Chr(34), vbNormalFocus DoCmd.DeleteObject acTable, "temp" انظر النتيجة في ملف الاكسل .......... Ba_Deffi.rar

اخي فايز ... ملف الاكسل المرفق . يخص مادة الاجتماعيات . فهل هذا يعني ان جميع المواد بنفس حقول المتابعة ام هي مختلف ؟؟؟ لان هناك مواد تختلف طريقة التقييم فيها مثل مواد العلوم . احياء . فيزياء ... وكذلك الحال لمواد المكتبة والبحث ... والقران الكريم ... وهكذا....

تفضل كود لتصدير الاسعلام On Error Resume Next DoCmd.OutputTo acOutputQuery, "الموظف", acFormatXLSX, CurrentProject.Path & "\استعلام الموظفين.xlsx", True Dim strSQL As String Beep MsgBox "تم تصدير بيانات الاستعلام بنجاح" أما بخصوص استيراد الاستعلام فيتم استيراد الاستعلام داخل جدول وليس استعلام اسف اخي محمد لم ارى اجابتك

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

والله مريت بس يبدو لي اني لم احتسي كوبا من القهوة لذلك انظر المرفق وبدون قهوة .... لس راضي عنه ولكن ........ ان ناسبتك الفكرة طبقها والا ارم بها في عرض البحر ... ba_TT21.mdb