Shivan Rekany

اليك هذه الوحدة النمطية ... في الحقيقة لا اعرف من هو صاحب الكود Private Const NV_CLOSEMSGBOX = &H5000& Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, _ ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, _ ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, _ ByVal nIDEvent As Long) As Long Private mTitle As String Private mPause As Long Private mHandle As Long Public Function MsgBoxPause(ByVal hwnd As Long, ByVal inPrompt As String, _ ByVal inTitle As String, ByVal inButtons As Long, _ ByVal inPause As Integer) As Integer mTitle = inTitle: mPause = inPause * 1000 SetTimer hwnd, NV_CLOSEMSGBOX, mPause, AddressOf NewTimerProc MsgBoxPause = MessageBox(hwnd, inPrompt, inTitle, inButtons) End Function Public Function NewTimerProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wparam As Long, _ ByVal lparam As Long) As Long KillTimer hwnd, wparam If wparam = NV_CLOSEMSGBOX Then mHandle = FindWindow("#32770", mTitle) If mHandle <> 0 Then SetForegroundWindow mHandle SendKeys "{enter}" End If End If End Function وفي النموذج تكتب هكذا او تقدر تعمل زر لهذا الامر Option Compare Database Private Sub Form_Load() Dim s As Integer s = 5 ' عدد الثواني mResult = MsgBoxPause(hwnd, "الرجاء انتظار " & s & " ثواني . ", _ "العنوان", vbOKCancel + vbExclamation + vbDefaultButton2 + vbMsgBoxRight + vbMsgBoxRtlReading, s) End Sub اليك القاعدة اخفاء الرسالة بعد ثواني محددة.accdb

اهلا بك الزر الاول يعطي الكود الاسفل للنسخة من نموذج Frm1 اللي اسمه F Public Function Startup() On Error Resume Next F.OnClose = "=BackUpMyDb()" & "=CopactMyDb()" End Function والزر الثاني يعطي الكود الاسفل اي يبدل الكود للنموذج F ب لا شيء Public Function CnacelStartup() On Error Resume Next F.OnClose = "" End Function تقبل تحياتي حسب رأيي هذه الطريقة احسن من ذلك لان الضغط واصلاح اليومي ليس مستحسن هذا رأيي فقط اي متى احتاجت لضغط واصلاح تقدر ان تضغط الزر وعند الاغلاق راح يعمل نسخة احتياطية اولا وبعدين راح يعمل ضغط واصلاح بارك الله فيك وفينا اجمعين

افتخر بك استاذي الحبيب , وين كنت كان غايب من زمان و شكرا لك

اتفضل اليك ما طلبت ProgAssit24.rar

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

تسلم اخي الحبيب ... شكرا لك بارك الله فيك و فينا اجمعين ... شكرا

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

اتفضل تم اضافة موضوع جديد على هذا اتمنى ان تستفيد منه

احبائي اعضاء المنتدى اوفيسنا السلام عليكم ورحمة الله وبركاته في هذه الاونة الاخيرة اشوف ان كثير من احبائنا بيسئلون عن ضغط و اصلاح و نسخ الاحتياطية لذلك قمت بدمج موضوعين واحد للسيد @أبو إبراهيم الغامدي والسيد @أ / محمد صالح وتم اضافة ملح و و بهارات شوية واهديكم ....... الى الموضوع هناك نموذجين بداخل القاعدة واحد اسمه Frm1 والاخر Form1 وفي نموذج Form1 هناك زرين الاول كتبت عليه ( قم بعمل كومباكت و نسخة احتياطية عند الاغلاق ) اي اذا ضغطت علي و في النهاية قمت باغلاق القاعدة اولا سيعمل نسخة احتياطية و بعدين سيعمل كومباكت اي ضغط و اصلاح القاعدة -------- اما الزر الثاني انا كتبت عليه ( الغي عمل كومباكت و نسخة احتياطية عند الاغلاق ) اي اذا ضغطت على الزر الاول وبعدين غيرت رأيك بعمل نسخة احتياطية او عمل كومباكت اي ضغط واصلاح القاعدة تقدر ان تضغط اليه واذا اغلقت القاعدة ما بيعمل كمباكت و نسخة الاحتياطية واستخدمنا هذه الاكواد في وحدة نمطية Option Compare Database Dim F As New Form_Frm1 Public Function Startup() On Error Resume Next F.OnClose = "=BackUpMyDb()" & "=CopactMyDb()" End Function Public Function CnacelStartup() On Error Resume Next F.OnClose = "" End Function Public Function BackUpMyDb() Dim MyPath As String, math1 As String, math2 As String math1 = CurrentProject.Path math2 = math1 & "\MyProg" MyPath = math2 & "\BackUpSaved" On Error GoTo MyErr Dim OldFile, DBwithEXT, DBwithoutEXT, NewFile, CopyMyDB, TypeApp OldFile = CurrentDb.Name DBwithEXT = Dir(OldFile) If Right(DBwithEXT, 5) = "accdb" Then DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) TypeApp = ".Accdb" ElseIf Right(DBwithEXT, 3) = "Mdb" Then DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4) TypeApp = ".Mdb" End If If Dir(math2, vbDirectory) = "" Then MkDir math2 If Dir(MyPath, vbDirectory) = "" Then MkDir MyPath NewFile = MyPath & "\" & DBwithoutEXT & "-" & Format(Now, "yyyy-mm-dd-Hh-Nn-Ss") & TypeApp CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Function Public Function compactDb(ByVal mydb As String, ByVal mypass As String, Optional openIt As Boolean = False) Dim F As Integer Dim filenoext As String, extension As String, Access As String Access = """" & SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE""" filenoext = Left(mydb, InStrRev(mydb, ".")) extension = Right(mydb, Len(mydb) - InStrRev(mydb, ".")) F = FreeFile Open CurrentProject.Path & "\compact.bat" For Output As F 'wait until the Db closes (ldb file is gone), then compact it Print #F, "CHCP 1256" Print #F, ":checkldb1" Print #F, "if exist """ & filenoext & "l" & extension & """ goto checkldb1" Print #F, Access & " """ & mydb & """" & mypass & " /compact" If openIt Then 'wait until the Db closes, then start it Print #F, ":checkldb2" Print #F, "if exist """ & filenoext & "l" & extension & """ goto checkldb2" Print #F, Access & " """ & mydb & """" Else Print #F, "del ""%~f0""" End If Close F End Function Public Function CopactMyDb() On Error Resume Next Dim MyPath As String MyPath = CurrentProject.Path & "\" & CurrentProject.Name Call compactDb(MyPath, "", True) Shell """" & Left(MyPath, InStrRev(MyPath, "\")) & "\compact.bat""", 0 DoCmd.Quit acQuitSaveAll End Function واليكم القاعدة compactInClose.accdb

اتفضل ProgAssit24.rar

اذا اليك هذا ProgAssit23.rar

القي نظرتا الى هذا ProgAssit23.rar

اليك هذا ProgAssit23.rar

اتفضل استخدم هذا Private Sub name_cors_Click() If IsNull(Form_frmstu.corse1) = True Then Form_frmstu.corse1 = Me.name_cors Else Form_frmstu.corse1 = Form_frmstu.corse1 & vbCrLf & Me.name_cors End If DoCmd.Close acForm, Me.Name Form_frmstu.Refresh End Sub وتقدر ان تبدل vbCrLf ب " ; " اذا تريد ان يكون الكل في صف الواحدة stu.rar

اتفضل تقدر استخدم احد اسطر التالية 1 - DoCmd.RunSQL "INSERT INTO Tbl_Entries ( teno ) SELECT DMax(""[eno]"",""[tbl_ehead]"")" او هذا DoCmd.RunSQL "INSERT INTO Tbl_Entries ( teno ) SELECT Max(Tbl_ehead.eno) AS MaxOfeno FROM Tbl_ehead;" واليك المثال بعد تعديل Insert Dmax.accdb

تريد ان يضيف كورس هكذا اذا اكثر من كورس واحد اكسل ; وورد ; اكسس في مربع نصي

هناك اثنين من "" لكل مكان وليس واحدا اي استخدم مثل اللي كتبت انا في المشاركتي السابقة واذا ترفق نسخة مصغرة راح يسهل علينا لكي نوصل للحل المطلوب

اتفضل استخدم هذا DoCmd.SelectObject acForm, "A", True DoCmd.PrintOut acPages PRR.rar

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

استخدم هذا DoCmd.RunSQL "INSERT INTO Tbl_Entries.teno SELECT DMax(""[eno]"",""[tbl_ehead]"")" واذا عطيتك خطأ ارفق نسخة مصغرة من القاعدة

بنسبة لي سؤالك غير واضحة ابدا ممكن تعطينا طريقة العمل باسماء الكائناات

تقدر تعمل هذا بدون اكواد اي تغيير في خصائص القاعدة هكذا وهذا كود لعمل ذلك في مشاركة استاذ @sandanet

اليك هذا تقدر تعمله بين تاريخين ايضا Database161_(1)_(1).accdb

اليك هذا =IIf(Not IsNull([nofatora]);Nz(DSum("[item_preis]";"tabol_sdad_mord";"[tabol_sdad_mord]![fatora_no]=[nofatora]" & "And [dete_add] Between [Forms]![formm7]![snddate] And [Forms]![formm7]![snddate2]");0);0) Database161_(1).accdb

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