محمد أبوعبدالله

وعليكم السلام ورحمة الله وبركاته ضع الكود التالي في زر استعراض With Application.FileDialog(3) .Title = "Choose File" .Filters.Clear .Filters.Clear .Filters.Add "Excel 2007-2013", "*.xlsx" .Filters.Add "Excel 2003", "*.xls" .AllowMultiSelect = False .InitialFileName = "" If .Show = -1 Then Me.FilePath.Value = .SelectedItems(1) End If End With واستبدل الكود التالي في زر استيراد ImpEX = CurrentProject.Path & "\" & "tbl_Items.XLSX" بالتالي ImpEX = Me.FilePath.Value DATA10041.mdb تحياتي ايضا تفضل هذا الموضوع اخي الكريم ستجد به فوائد كثيرة ان شاء الله تحياتي

وعليكم السلام ورحمة الله وبركاته قم بتحميل تطبيق google drive https://www.google.com/drive/download/ قم بتحديد مجلد google drive في المكان الذي تريده قم بعمل كود لانشاء نسخة احتياطية في حدث الاغلاق If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", _ vbQuestion + vbYesNo, _ "نسخة احتياطية") = vbYes Then On Error Resume Next Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\Backup" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) End If OldFile = CurrentDb.Name ' السطر التالي قم بتغييره الى مسار الحفظ الجديد StrNew = CurrentProject.Path & "\Backup" DBwithEXT = Dir(OldFile) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) If [BKUP] = True Then NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Exit Sub End If End If انتبه لتغيير المسار تحياتي تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم DoCmd.OpenReport "EMPDEVMENU", acViewPreview, , myCriteria Test_It1.rar تحياتي

جميل استاذنا الفاضل عمل موفق ورائع ما شاء الله عليك تحياتي

حصل 🙂

وعليكم السلام ورحمة الله وبركاته بالاضافة الى ما تفضل به الاخوة الكرام ولهم جزيل الشكر وبحسب ترتيب حروف " ابجد هوز حطي كلمن " وكما هو موجود بالنموذج 14 حرف وكما هو موضح بمثالك ( الحرف الاول - الحرف الثاني ... الخ ) يكون الكود كالتالي Option Compare Database Option Explicit Private Sub XTotal_Exit() If Me.A = "ا" Then Me.A1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.A & "'") Else Me.A1 = 0 End If If Me.B = "ب" Then Me.B1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.B & "'") Else Me.B1 = 0 End If If Me.C = "ج" Then Me.C1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.C & "'") Else Me.C1 = 0 End If If Me.D = "د" Then Me.D1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.D & "'") Else Me.D1 = 0 End If If Me.E = "ه" Then Me.E1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.E & "'") Else Me.E1 = 0 End If If Me.F = "و" Then Me.F1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.F & "'") Else Me.F1 = 0 End If If Me.G = "ز" Then Me.G1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.G & "'") Else Me.G1 = 0 End If If Me.H = "ح" Then Me.H1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.H & "'") Else Me.H1 = 0 End If If Me.I = "ط" Then Me.I1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.I & "'") Else Me.I1 = 0 End If If Me.J = "ي" Then Me.J1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.J & "'") Else Me.J1 = 0 End If If Me.K = "ك" Then Me.K1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.K & "'") Else Me.K1 = 0 End If If Me.L = "ل" Then Me.L1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.L & "'") Else Me.L1 = 0 End If If Me.M = "م" Then Me.M1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.M & "'") Else Me.M1 = 0 End If If Me.n = "ن" Then Me.n1.Value = DLookup("[N]", "Query1", "[L] ='" & Me.n & "'") Else Me.n1 = 0 End If Me.tot.Value = Nz(A1) + Nz(B1) + Nz(C1) + Nz(D1) + Nz(E1) + Nz(F1) + Nz(G1) + Nz(H1) + Nz(I1) + Nz(J1) + Nz(K1) + Nz(L1) + Nz(M1) + Nz(n1) ' Debug.Print Me.tot End Sub Private Sub A_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub b_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub c_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub d_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub e_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub f_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub g_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub h_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub i_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub j_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub k_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub l_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub m_Exit(Cancel As Integer) Call XTotal_Exit End Sub Private Sub n_Exit(Cancel As Integer) Call XTotal_Exit End Sub 001.rar تحياتي

يمكن تغيير خاصية محاذاة النص الى توزيع تحياتي

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

استعلام abc هو استعلام تجميعي اما لو اردت عرض التاريخ فقم بتصميم تقرير يعتمد على جدول 22 واسفل التقرير اجمع الايام تحياتي

السلام عليكم انت تريد عدد حقل prop وهذا الحقل غير موجود في جدول2 والصحيح ان يكون geab والمعادلة كالتالي abs: DCount("[geab]";"22";"[s]='" & [1]![S] & "'") ASD123.accdb تحياتي

تفضل اخي الكريم تحياتي

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

جزاك الله خيرا استاذي الفاضل تعلمنا منكم الكثير فجزاكم الله عنا كل خير تحياتي

بالاضافة الى ما تفضل به استاذنا الجليل @ابوخليل وله جزيل الشكر تفضل اخي الكريم ضع هذا الكود في موديول جديد Public Sub Set_Pass(sDBName As String, soLdPass As String, Optional sNewPass As String = "") Dim db As DAO.Database On Error GoTo Err: Set db = OpenDatabase(sDBName, True, False, ";PWD=" & soLdPass) db.NewPassword soLdPass, sNewPass Exit Sub Err: Resume Next End Sub وهذا الكود في زر امر Dim DB_Full_Name As String Dim DB_Pass As String DB_Pass = 777 ' كلمة مرور قاعدة بيانات aa.mdb DB_Full_Name = CurrentProject.Path & "\" & "aa.mdb" Set_Pass DB_Full_Name, DB_Pass ShellExecute Me.hwnd, "open", DB_Full_Name, "", "", 1 تحياتي

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

او بطريقة اخرى Private Sub Form_Load() X = CurrentProject.Path & "\Setting.ini" If Len(Dir(X)) = 0 Then Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(CurrentProject.Path & "\Setting.ini", True) a.WriteLine ("1") a.Close Else Open CurrentProject.Path & "\Setting.ini" For Input As #1 Input #1, X Me.L1 = X Close #1 End If End Sub تحياتي

تفضل اخي الكريم Private Sub Form_Load() On Error GoTo err: Dim X As String Open CurrentProject.Path & "\Setting.ini" For Input As #1 Input #1, X Me.L1 = X Close #1 err: Set fs = CreateObject("Scripting.FileSystemObject") Set a = fs.CreateTextFile(CurrentProject.Path & "\Setting.ini", True) a.WriteLine ("1") a.Close End Sub تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Private Sub cmdSave_Click() X1 = CurrentProject.Path & "\Setting.ini" X3 = FreeFile Open X1 For Input As X3 Line Input #X3, X X5 = X5 & X Close X3 If Me.L1 = 1 Then X7 = 2 Else X7 = 1 End If X5 = Replace(X5, X7, Me.L1) X3 = FreeFile Open X1 For Output As X3 Print #X3, X5 Close X3 End Sub Private Sub Form_Load() Dim X As String Open CurrentProject.Path & "\Setting.ini" For Input As #1 Input #1, X Me.L1 = X Close #1 End Sub Project201.rar تحياتي

لا ليس ضروري ولكن وضعته للانتقال للسجل التالي ضعها بعد امر الحذف ولكن ليس بديل عنه تحياتي

سيكون بالشكل التالي Dim db As DAO.Database Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNational WHERE NationalID =" & cbjobNo) rs.Delete rs.MoveNext rs.Close Set rs = Nothing تحياتي

وعليكم السلام وحمة الله وبركاته تفضل اخي الكريم اذا كان حقل NationalID رقم Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNational WHERE NationalID =" & cbjobNo) اذا كان حقل NationalID نص Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNational WHERE NationalID ='" & cbjobNo & "'") تحياتي

السلام عليكم جرب الكود التالي Private Sub Form_Resize() DoCmd.Maximize End Sub تحياتي

بالاضافة الى ما تفضل به استاذنا الفاضل @د.كاف يار وله جزيل الشكر تفضل اخي الكريم جرب الكود التالي Dim strFolderPath As String Dim DB_Full_Name As String Dim DB_Name As String Dim Backup_Full_Name As String Dim Copy_File As Variant Dim DB_Directory As String strFolderPath = CurrentProject.Path & "\Backup\" ' التاكد من وجود مجلد Backup ' اذ لم يكن موجود يتم انشائه If Len(Dir(strFolderPath, vbDirectory)) = 0 Then MkDir strFolderPath End If ' تحديد قاعدة البيانات DB_Full_Name = CurrentProject.Path & "\" & CurrentProject.Name ' تحديد مسار قاعدة البيانات DB_Directory = CurrentProject.Path ' تحديد اسم قاعدة البيانات DB_Name = CurrentProject.Name ' تحديد مسار النسحة الاحتياطية Backup_Full_Name = strFolderPath & Left(DB_Name, Len(DB_Name) - 6) & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & ".accde" If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", vbQuestion + vbYesNo, "نسخة احتياطية") = vbYes Then Set Copy_File = CreateObject("Scripting.FileSystemObject") Copy_File.copyfile DB_Full_Name, Backup_Full_Name, True End If تحياتي

وعليكم السلام ورحمة الله وبركاته جرب الكود التالي =Nz(DMax("int([رقم_القيد])";"السيارات");0)+1 وهو يعمل اذا كان الحقل نص او رقم تحيايت

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