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

السلام عليكم
حمل المرفق
اذا كان الويندوز 32 الصقه في المسار التالي
C:\WINDOWS\system32\ ثم استخدم الامر التالي من cmd ولا تنسى التشغيل كمسئول
regsvr32 "C:\WINDOWS\system32\barcodex.ocx" اذا كان الويندوز 64 الصقه في المسار التالي
C:\WINDOWS\SysWOW64\ ثم استخدم الامر التالي من cmd ولا تنسى التشغيل كمسئول
regsvr32 "C:\WINDOWS\SysWOW64\barcodex.ocx" barcodex.rar
تحياتي

تفضل اخي الكريم
رقم DLookup = DLookup("My_Filde", "My_Table", "My_Filde1 =" & myWhere) نص DLookup = DLookup("My_Filde", "My_Table", "My_Filde1 ='" & myWhere & "'") تاريخ DLookup = DLookup("My_Filde", "My_Table", "My_Filde1 = #" & myWhere & "#") تحياتي

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

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

حقل item نوعه نص لذلك يجب تعديل الكود ليكون بالشكل التالي
Dim rst As DAO.Recordset Me.SubForm.SetFocus Set rst = Me.SubForm.Form.RecordsetClone rst.FindFirst "[item] ='" & Forms!FormMin!txt_item & "'" Me.SubForm.Form.Bookmark = rst.Bookmark Set rst = Nothing Me.SubForm.Form!Quantity.SetFocus New Microsoft Access Database (2).rar
تحياتي

تفضل اخي الكريم
If Not Len(Me.نص7 & vbNullString) = 0 Then Set rst = Me.RecordsetClone rst.FindFirst "[اسم التلميذ] = '" & Me.نص7 & "'" If rst.NoMatch Then MsgBox "هذا الاسم غير مسجل" Else Me.Bookmark = rst.Bookmark End If Set rst = Nothing End If بحث من خلال اسم التلميذ.rar
تحياتي

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

السلام عليكم
بالاضافة الى ما تفضل به استاذنا الفاضل Mossak وله الشكر
تفضل اخي الكريم
user..date..date.rar
 
تحياتي

وعليكم السلام ورحمة الله وبركاته
تفضل اخي الكريم
يمكنك استخدام الكود التالي لاخفاء مربعات النص التي قيمتها = 0
Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If ctl.Value = 0 Then ctl.Visible = False End If Next ctl hid.rar
تحياتي

وعليكم السلام ورحمة الله وبركاته
تفضل اخي الكريم
On Error Resume Next If IsNull([b3]) Then MsgBox "يجب أولا أختــــــــــيار اسم المورد", vbCritical, "warning" Else DoCmd.OpenReport "QPa_yme3 ", acViewPreview, , "[Da_pay4]=#" & Format(Me.b3, "mm/dd/yyyy") & "#" DoCmd.RunCommand acCmdZoom100 End If العملاء.rar
تحياتي

تفضل اخي الكريم
Dim i As Integer With Application.Forms For i = .Count - 1 To 0 Step -1 With .Item(i) If .Name <> "FXY" Then DoCmd.Close acForm, .Name End If End With Next i End With DoCmd.OpenForm "FXY" With Application.Reports For i = .Count - 1 To 0 Step -1 With .Item(i) DoCmd.Close acReport, .Name End With Next i End With تحياتي

تفضل اخي الكريم هذه طريقة افضل واسرع
ضع الكود التالي في وحدة نمطية جديدة
Public Function XNul(txt1 As Double, txt3 As Double) As Double If Nz(txt1, 0) > 0 And Nz(txt3, 0) > 0 Then XNul = (txt1 / txt3) * 100 Else XNul = 0 End If End Function ثم في الاستعلام ضع التالي مع تغيير اسماء الحقول
Expr1: XNul(Nz([المدفوعات]);Nz([صافى الفواتير])) تحياتي

وعليكم السلام ورحمة الله وبركاته
تفضل اخي الكريم
Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then ctl.Value = Null End If Next ctl تحياتي

وعليكم السلام ورحمة الله وبركاته
بالاضافة الى ما تفضل به استاذنا الفاضل @ابوخليل وله الشكر
جرب الكود التالي
Me.Filter = "noo =" & Me.مربع_تحرير_وسرد7 Me.FilterOn = True Me.Requery If Me.sec.Value = "سري" Then Me.Visible = False If InputBox("الرجاء ادخال كلمة السر لفتح النموذج", "فتح النموذج") = "123" Then Me.Visible = True Else Me.Visible = False DoCmd.GoToRecord , , acNewRec End If End If b21.accdb
تحياتي

وعليكم السلام ورحمة الله وبركاته
اضعط زر Shift + زر 6 بالاعلى ^
تحياتي
10^9

وعليكم السلام ورحمة الله وبركاته
تفضل اخي الكريم
تحياتي

وعليكم السلام ورحمة الله وبركاته
في قاعدة البيانات لديك مكتبات غير متوفرة في الجهاز الجديد يمكن تحميلهم من الانترنت او نسخهم من الجهاز الاول الى الجهاز الجديد
ستجدهم في المسار التالي
windows 32 bit
C:\Windows\System32 windows 64 bit
C:\Windows\SysWOW64 والمكتبات المطلوبة هي
Aec32BitAppServer57.tlb
accessibility.api
تحياتي

وعليكم السلام ورحمة الله وبركاته
وهذا تعديل بسيط لما تفضل به استاذنا الفاضل @د.كاف يار وله الشكر
qqq1: IIf(Nz(DLookUp("qty";"Table1";"ID=" & [ID]);0)>Nz(DLookUp("qty";"Table1";"ID=" & [ID]+1);0);"Yes";"NO") Databaseee1.accdb
تحياتي

وعليكم السلام ورحمة الله وبركاته
تفضل اخي الكريم
Private Sub Command105_Click() On Error GoTo Err: DoCmd.GoToRecord , , acNext Err: If Err.Number = 2105 Then Exit Sub End If End Sub Private Sub Command106_Click() On Error GoTo Err: DoCmd.GoToRecord , , acPrevious Err: If Err.Number = 2105 Then Exit Sub End If End Sub thaaer.rar
تحياتي

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

وعليكم السلام ورحمة الله وبركاته
تفضل اخي الكريم
Private Sub nihayat_altarkhis_Exit(Cancel As Integer) If [aintiha alsijil] > [nihayat altarkhis] Then DoCmd.CancelEvent MsgBox "التاريخ اكبر من التاريخ المطلوب" ElseIf [nihayat aldaman albankii] > [nihayat altarkhis] Then DoCmd.CancelEvent MsgBox "التاريخ اكبر من التاريخ المطلوب" End If End Sub Database72.rar
تحياتي

السلام عليكم
افتح موديول جديد وضع به الكود التالي ووظيفته حذف جميع المسافات بالنص
Function NoSpace(X3 As String) As String Dim X5 As String X5 = RTrim(X3) Do While InStr(X5, " ") > 0 X5 = Left(X5, InStr(X5, " ") - 1) & Mid(X5, InStr(X5, " ") + 1) Loop NoSpace = Trim(X5) End Function وفي النموذج اضف مربع نص جديد لكتابة النص به
وضع به الكود التالي في حدث عند الخروج
On Error GoTo Err: If IsNull(Me.Text79) Then DoCmd.CancelEvent Else X1 = NoSpace(Me.Text79) ' Debug.Print X1 Me.[1].Value = Mid(X1, 1, 1) Me.[2].Value = Mid(X1, 2, 1) Me.[3].Value = Mid(X1, 3, 1) Me.[4].Value = Mid(X1, 4, 1) Me.[5].Value = Mid(X1, 5, 1) Me.[6].Value = Mid(X1, 6, 1) Me.[7].Value = Mid(X1, 7, 1) Me.[8].Value = Mid(X1, 8, 1) Me.[9].Value = Mid(X1, 9, 1) Me.[10].Value = Mid(X1, 10, 1) Me.[11].Value = Mid(X1, 11, 1) Me.[12].Value = Mid(X1, 12, 1) Me.[13].Value = Mid(X1, 13, 1) Me.[14].Value = Mid(X1, 14, 1) Me.[15].Value = Mid(X1, 15, 1) Me.[16].Value = Mid(X1, 16, 1) Me.[17].Value = Mid(X1, 17, 1) Me.[18].Value = Mid(X1, 18, 1) Me.[19].Value = Mid(X1, 19, 1) Me.[20].Value = Mid(X1, 20, 1) Me.[21].Value = Mid(X1, 21, 1) Me.[22].Value = Mid(X1, 22, 1) Me.[23].Value = Mid(X1, 23, 1) Me.[24].Value = Mid(X1, 24, 1) Me.[25].Value = Mid(X1, 25, 1) Me.[26].Value = Mid(X1, 26, 1) Me.[27].Value = Mid(X1, 27, 1) Me.[28].Value = Mid(X1, 28, 1) Me.[29].Value = Mid(X1, 29, 1) Me.[30].Value = Mid(X1, 30, 1) End If Err: حروف.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() 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 تحياتي

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