Jump to content
أوفيسنا

Leaderboard

Popular Content

Showing content with the highest reputation since 07/18/2021 in all areas

  1. تفضل هذا ملفك بعد التعديل لاحظ استعمال المعادلة في جلب اسم مالك الشقة بدلا من كتابته واستعمال رقم الصف كبديل للترقيم وتغيير تنسيق التاريخ والأرقام بالتوفيق مصروفات وايرادات1.xlsm
    4 points
  2. شكرا لكلماتك الطيبة أنا شخصيا لم اغير إلا فيما يحقق الشرط الخاص بك على اعتبار ان الكود يعمل معك قبل ذلك لذلك إذا كنت تقصد تحويل النص المكتوب في مربع النص إلى تاريخ يمكنك تعديل Me.TextBox16.Value في الشرط إلى cdate(Me.TextBox16.Value) تم تعديل الكود كاملا في المشاركة الأصلية بالتوفيق
    3 points
  3. وعليكم السلام وحمة الله وبركاته تفضل اخي الكريم اذا كان حقل NationalID رقم Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNational WHERE NationalID =" & cbjobNo) اذا كان حقل NationalID نص Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNational WHERE NationalID ='" & cbjobNo & "'") تحياتي
    3 points
  4. 3 points
  5. وعليكم السلام 🙂 وبسبب انك ما اعطيتنا معلومات كافية ، فاختر المثال الاول او الثاني ، وكلاهما على حدث "النقر المزدوج" : الاول للنقر المزدوج للنموذج ، والثاني للحقل : جعفر
    3 points
  6. تفضل هذا الكود فقط انسخ و الصق في ازرار النسخة الاحتياطية On Error GoTo ErrH Dim fso As Object Dim fldrname As String Dim fldrpath As String Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\Backup" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" End If Dim MyFile, DstFile, DataName As String Dim Syso As Object MyFile = CurrentProject.FullName DataName= "Backup-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ")" DstFile = CurrentProject.Path & "\Backup\" & DataName & ".accdb" DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" Dim db As DAO.Database Dim MaxBackup_NO As Integer MaxBackup_NO = Nz(DMax("[Backup_NO]", "[Backup]"), 0) + 1 Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Backup") With rs .AddNew ![Backup_NO] = MaxBackup_NO ![Backup_Name] = DataName ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With rs.Close Set rs = Nothing MsgBox "تم انشاء قاعدة البيانات بنجاح", vbMsgBoxRight + vbOKOnly, "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select
    3 points
  7. السلام عليكم Int([a1a]/[b1b]+0.5)
    3 points
  8. وعليكم السلام ورحمة الله وبركاته غير خاصية POP UP الى NO data.rar تحياتي
    3 points
  9. سبحان الله ، هذا المنتدى يحتاج إلى محكمين من خارجه حتى لا يضيع الطلبة والمبتدئون. هذا مثال للدالة التي نصحت بها ودالة الدكتور ، أرجو لصقه ثم تشغيل الإجاراءين لمعرفة الفرق بين النتائج ووقت التنفيذ. كود في قمة الإتقان لم أرى شبيها له قبله ولن يأتي بعده ، واللي يحب يعترض يقابلني سنة 2500 ميلادي. Function CountWkDay(ByVal Date1 As Long, _ ByVal Date2 As Long, _ WkDay As Byte) As Variant If Date1 <= Date2 Then Date1 = Date1 - 1 Else Date2 = Date2 - 1 End If Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Abs(Date2 - Date1) End Function Function WkDayCount(VarDate As Date, enddate As Date) As Long 'دالة د. كاف يار Dim SFriday As Long Do While VarDate < enddate VarDate = DateAdd("D", 1, VarDate) If Weekday(VarDate, 2) = vbFriday Then SFriday = SFriday + 1 End If Loop WkDayCount = SFriday End Function Sub Test1() Dim Date1 As Date Dim Date2 As Date Date1 = DateSerial(2021, 7, 23) Date2 = DateSerial(2021, 7, 30) Debug.Print CountWkDay(Date1, Date2, vbFriday) Debug.Print WkDayCount(Date1, Date2) End Sub Sub Test2() Dim Date1 As Date Dim Date2 As Date Dim Start As Single Date1 = DateSerial(2021, 7, 23) Date2 = DateSerial(9000, 7, 25) Start = Timer Debug.Print CountWkDay(Date1, Date2, vbFriday), Timer - Start Start = Timer Debug.Print WkDayCount(Date1, Date2), Timer - Start End Sub
    3 points
  10. اتفضلوا البرنامج العملاء_والديون_اقساط_0777134668.accdb
    3 points
  11. اسماء الحقول اصبحت C1 و C2 و C3 ، واعمل خلفيتهم باللون الذي تحب ، وعند حدث بعد التحديث ، سيتم اختيار المربع الذي يحمل نفي الرقم ، بنفس لون الخلفية: استعمل هذا الكود : Private Sub Select_it(ctl As Control) For i = 1 To 32 If Me("[" & i & "]") = Me(ctl.Name) Then Me("[" & i & "]").BackColor = Me(ctl.Name).BackColor End If Next i End Sub Private Sub C1_AfterUpdate() Call Select_it(C1) End Sub Private Sub C2_AfterUpdate() Call Select_it(C2) End Sub Private Sub C3_AfterUpdate() Call Select_it(C3) End Sub . جعفر 1402.1.Random Numbers.accdb.zip
    3 points
  12. الآن فهمت انك تحتاج توليد الرقم داخل نطاق الرقمين اتفضل التعديل توليد رقم عشوائي.accdb
    3 points
  13. 3 points
  14. كلامك صحيح أنا أستعمل التعبير في الاستعلام والتقرير بدلا من الحقل المحسوب في الجدول ولكن هذا ما يبحث عنه الأخ صاحب السؤال بالتوفيق
    2 points
  15. استاذنا العزيز محمد ... لا اعرف لماذا لا اقتنع بحقل محسوب .. بالاساس هو معادلة رياضية فتخيل لو عندنا مئات الالاف من السجلات وبالتاكيد سوف يكون هناك ضغط على الحاسوب وبطء في اعطاء النتائج
    2 points
  16. اعتقد بانها لا تصلح مع رقم تلقائي .. واذا اردنا ان نعملها مع رقم تلقائي فيجب ان نعملها بحقل نصي اخر يأخذ قيمته من الرقم التلقائي
    2 points
  17. السلام عليكم جرب هذا الكود = "E" & (Right(Nz(DMax("[FileNo]", "TblEmpl"), 100000), 6) + 1)
    2 points
  18. لا ليس ضروري ولكن وضعته للانتقال للسجل التالي ضعها بعد امر الحذف ولكن ليس بديل عنه تحياتي
    2 points
  19. سيكون بالشكل التالي 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 تحياتي
    2 points
  20. جرب هذه Set rs = CurrentDb.OpenRecordset("SELECT * FROM tblNational WHERE NationalID =" [cbjobNo])
    2 points
  21. تقريبا الخطأ في أن الشرط في زر الحفظ والتعديل هو If C Like TextBox6.Value & "*" Then وهذا يعني أن الخلية تشبه الرقم وبعده أي رقم آخر * وربما يكون الصواب If c = Val(Me.TextBox6) Then وهو يعني تساوي الرقم مع الرقم المكتوب في مربع النص بالتوفيق
    2 points
  22. المطلوب غير واضح لي هل تقصد: إذا تساوت قيمة خلية في العمود f في الشيت micro يتم الترحيل في نفس الصف الذي تساوت فيه (طبعا في شيت micro) ولا يقوم بالترحيل في شيت raw وإذا تساوت قيمة خلية في العمود f في الشيت raw يتم الترحيل في نفس الصف الذي تساوت فيه ولا يقوم بالترحيل في شيت micro ؟؟؟
    2 points
  23. السلام عليكم جرب الكود التالي Private Sub Form_Resize() DoCmd.Maximize End Sub تحياتي
    2 points
  24. يمكنك استعمال هذا الكود في حدث عند الضغط على الزر Private Sub CommandButton1_Click() Dim iRow As Long, Lastrow As Long, i As Long With ورقة1 Lastrow = .Cells(.Rows.Count, 7).End(xlUp).Row For r = 3 To Lastrow If .Cells(r, 7) = TextBox1.Value Then iRow = .Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Row .Cells(iRow, 3).Value = Me.TextBox1.Value .Cells(iRow, 4).Value = Me.TextBox2.Value MsgBox " لقد تم الترحيل بنجاح ", vbExclamation + vbMsgBoxRight, "تم الترحيل " GoTo 1 End If Next End With MsgBox "لايوجد هذا الاسمً ", vbInformation + vbMsgBoxRight, "تنبيه" 1: TextBox1.Value = "" TextBox2.Value = "" TextBox1.SetFocus End Sub بالتوفيق
    2 points
  25. لا أدري أين المشكلة عندك ولكن إذا كنت تريد تطبيق ذلك على ملف آخر بامتداد xlsb أولا تفتح شاشة الفيجوال بيسك داخل اكسل ثم تضيف موديول جديد وتلصق فيه الكود الذي يتحقق من رقم الماذربورد Function MBSerialNumber(Optional strComputer As String = ".") As String Dim v, vName, vUUID With GetObject("winmgmts:\\" & strComputer & "\root\cimv2") For Each v In .ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", , 48) vName = v.Name: vUUID = v.UUID Next v End With MBSerialNumber = vName & ", " & vUUID End Function ثم تضغط دبل كلك على thisworkbook وتلصق هذا الكود في حدث عند فتح الملف Private Sub Workbook_Open() Dim strMB1 As String, strMB2 As String, strMB3 As String 'Put Your MotherBoard Serial strMB1 = "HP ProDesk 490 G1 MT, FF004080-EE39-11E3-BFF8-A0D3C13F35B2" strMB2 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" strMB3 = "HP Compaq 8500 Elite SFF PC, BFDEF800-AF9A-11E0-0000-2C27D742989F" Select Case MBSerialNumber Case strMB1, strMB2, strMB3 Exit Sub Case Else MsgBox ("Data Security Failure. This Workbook Will Close") ActiveWorkbook.Close 1 End Select End Sub ثم تقوم بحفظ التغييرات وتغلق وتفتح الملف مرة أخرى بالتوفيق
    2 points
  26. تقدر تستعمل النموذج الذي اعطيتك هنا: جعفر
    2 points
  27. اعتقد انك بهذه الطريقة ستقوم بجعل شكل الفاتورة غير مقبول الى حد ما لذلك يمكنك وضع شىء اخر السجلات كاجمالي الكمية او امالي الفاتورة او نص بتفقيط الفاتورة ... الخ NM.rar تحياتي
    2 points
  28. جربتها قبل أن أرفع مثالي ولم تنجح ، لماذا؟ ، لأنها بكل بساطة سوف تختار الحقل وسيظل السجل ثابتا لا يتبدل.
    2 points
  29. كفو و بيض الله و جهك و كلنا انشاء الله مكملين لبعض و نستفيد و نفيد
    2 points
  30. ما دام ان الطريق يؤدي إلى روما بركب أنا وياك بسيارة خاصة يا د / كاف هههههههههههههههههه
    2 points
  31. اجعل القيمة الافتراضية لرقم القيد =DLast("[رقم_القيد]";"السيارات")+1 عذرا استاذ عبد اللطيف ..ظننتك تريد اخر سجل وليس اكبر سجل
    2 points
  32. هذا الأمر سوف ينقلك دائما لأول سجل ، جرب أن تتخلص منه.
    2 points
  33. Dim rA As Range For Each rA In Columns("d").SpecialCells(xlConstants, xlNumbers).Areas rA.Cells(rA.Cells.Count + 1).Formula = "=SUM(" & rA.Address & ")" Next rA يقوم بوضع نتيجة جمع مدى معين في اخر خلية فارغة اسفل المدى بعد تشغيل الموديول ومن ثم المدى التالي في نفس العمود وهكذا ارجو ان يكون مفيد للجميع ..اسف للتاخر بالرد
    2 points
  34. الغي كود التحديث الموجود في حدث عن الفتح في التقرير لأني وضعت الكود لك ضمن كود تصدير البيانات اتفضل التعديل 111School_It_0001.zip
    2 points
  35. وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم =Round([totol];0) كسر عشري.accdb تحياتي
    2 points
  36. تفضل يا غالي التجربة 1 - جدول به 3 حقول يحتوي على بيانات ما يقرب من ربع مليون سجل 2 - كود متنوع يقوم باستعلام الحاق بثلاث طرق 3 - النتائج مبهرة '1 CurrentDb.Execute "DELETE * FROM Table3" X = Timer DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO Table3 ( text1, text2, text3 ) SELECT Table1.text1, Table1.text2, Table1.text3 FROM Table1;" DoCmd.SetWarnings True XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time1 " & "==========> " & XTime '2 CurrentDb.Execute "DELETE * FROM Table3" X = Timer CurrentDb.Execute "INSERT INTO Table3 ( text1, text2, text3 ) SELECT Table1.text1, Table1.text2, Table1.text3 FROM Table1;" XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time2 " & "==========> " & XTime '3 CurrentDb.Execute "DELETE * FROM Table3" X = Timer CurrentDb.Execute "Query1" XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time3 " & "==========> " & XTime '4 CurrentDb.Execute "DELETE * FROM Table3" X = Timer Dim db As DAO.Database Dim rs As DAO.Recordset Dim rst As DAO.Recordset Set rs = CurrentDb.OpenRecordset("Table1") Set rst = CurrentDb.OpenRecordset("Table3") For i = 1 To rs.RecordCount rst.AddNew rst.Fields(0) = rs.Fields(0) rst.Fields(1) = rs.Fields(1) rst.Fields(2) = rs.Fields(2) rst.Update rs.MoveNext Next rs.Close Set rs = Nothing rst.Close Set rst = Nothing XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time4 " & "==========> " & XTime Debug.Print "================================" db9.rar تحياتي
    2 points
  37. لا تظن ما ليس بي فلم أرد ولم أتحدث بسبب كلمة ( كما تريد ) لأنك قبل كل ذلك معلمي واستاذي وأقدرك واحترمك قبل كل شيء فالعين لا تعلى على الحاجب أما فهم المعنى فيختلف من إنسان إلى إنسان فعلماؤنا اختلفوا في كثير من الأمور كل حسب فهمه ألا نختلف انا وانت في فهم المقصد وأعتذر منك ومن الجميع لدخولنا في موضوع آخر
    2 points
  38. وهذه مشاركة مع اخي واستاذي العزيز استاذ جعفر بطريقة التنسيق الشرطي qqq.rar
    2 points
  39. نعم كان عبارة عن سؤال باستخدام اسلوب الاستفهام التعجبي وهو من الاساليب السبعة للاستفهام و من ذلك قوله تعالى " ما لهذا الرسول يأكل الطعام ويمشي في الأسواق " وقوله تعالى " كَيْفَ تَكْفُرُونَ بِاللَّهِ وَكُنتُمْ أَمْوَاتاً فَأَحْيَاكُمْ " وفي هذا النوع من الاستفهام لا يتطلب وضع العلامة " ؟ "
    2 points
  40. اشوفك تتسرّع في تعليقاتك !! ولو تغيّر التعليق الى سؤال ، فبتحصل على اجابات افضل 🙂 الهدف الاكبر من هذا الموضوع هو ، حماية البيانات : 1. اذا البيانات على السيرفر ، والاكسس متصل بجداوله في السيرفر ، فالرابط يكون مستمر بين الواجهة والجداول ، والشاطر يقدر يستعمل احد برامج "الشم" Sniffing والتوصل الى ما يشاء ، 2. بينما اتصالك بالكود للسيرفر وجلب البيانات ، ثم انقطاع الاتصال بالسيرفر ، يجعل الموضوع ذو امان اكثر 🙂 وللعلم ، فهناك العديد من الجهات التي تهتم بأمن البيانات ، تصر على ان تكون جميع كائناتها غير منضمه 🙂 جعفر
    2 points
  41. شكرا جزيلا اخوي حسام انك نبهتنا لخطأ التكرار ، واللي صعب معرفته غير انك تجعل الارقام من 1 الى 32 🙂 هذا تعديل الكود حقي : Private Sub cmd_Generate_Random_Click() Dim i As Integer Dim j As Integer Dim f As Integer Dim e As Integer Dim t As Single t = Timer 'احفظ سجل النموذج If Me.Dirty Then Me.Dirty = False f = Me.[f-no] e = Me.[e-no] For i = 1 To 32: Me("[" & i & "]") = 0: Next i For i = 1 To 32 Try_Again: Dim MyValue Randomize Timer MyValue = Int((e * Rnd) + f) '1. No Duplicates For j = 1 To i If Val(Me("[" & j & "]")) = MyValue Then GoTo Try_Again Next j '2 Smaller than, Or Greater than If MyValue < f Or MyValue > e Then GoTo Try_Again Else Me("[" & i & "]") = MyValue End If Next i Debug.Print Timer - t End Sub . وتلاحظ اني حسبت الوقت اللي الكود يأخذه في عمل اللازم ، ويمكن مقارنة سرعة الكود هذا مع كود اخوي حسين واخوي حسام 🙂 جعفر
    2 points
  42. السلام عليكم 🙂 الظاهر انك تتب طريقة خاصة في عمل فاتورة جديدة ، او انك وضعت الكود في حدث آخر !! لأن الكود الذي اعطيتك هو عينا نفس الكود الذي اعطاك الاخ خالد ، والاثنين يعطون تقرير برقم الفاتورة الموجودة في النموذج او النموذج الفرعي !! على العموم ، هذه صورة عن مكان الكود الذي وضعته انا : . وهذا تعديل بسيط لحفظ السجل قبل طباعة التقرير: Dim stDocName As String If Me.Dirty Then Me.Dirty = False stDocName = "re3" 'DoCmd.OpenReport stDocName, acNormal, , "[invo]=" & Me.invo DoCmd.OpenReport stDocName, acViewPreview, , "[invo]=" & Me.invo جعفر
    2 points
  43. جرب الامر Dim stDocName As String stDocName = "re3" DoCmd.OpenReport stDocName, acNormal, , "[invo]=" & Me.Parent!id الملف مرفق برنامجي.mdb
    2 points
  44. السلام عليكم الطريقتان لهما عيوب ومميزات ويختلف حسب حجم العمل وعدد المستخدمين وانصحك بزيارة هذا الموضوع ستجد به مناقاشات وحلول مفيدة باذن الله تحياتي
    2 points
  45. جزاكم الله خيرا على المساعدة وكل عام وحضراتكم بخير عيد أضحى سعيد
    2 points
  46. حسب فهمي للمطلوب يمكنك استعمال هذا الكود Private Sub CommandButton5_Click() If ActiveSheet.Name <> "data" Then Dim wslr As Integer, counter As Integer, ws As Worksheet Set ws = ThisWorkbook.Worksheets("data") wslr = ws.Cells(Rows.Count, 1).End(xlUp).Row For counter = 1 To wslr If ws.Cells(counter, 2) = TextBox1.Value Then ws.Cells(counter, 2).EntireRow.Delete counter = counter - 1 End If Next MsgBox "تم حذف الاسم" End If End Sub
    2 points
  47. السلام عليكم 🙂 الخطأ يقول ان الكائن tbl_dece لا يوجد في النموذج Data member not found) : . اذا تلاحظ اسم حاوية النموذج الفرعي في النموذج ، اسمها يطابق الاسم في الكود ، فلم تحصل على خطأ هنا : . ولكن اسم حاوية النموذج الفرعي في النموذج ، اسمها لا يطابق الاسم في الكود ، لذا فالاسم الموجود في الكود غير موجود في النموذج اصلا : . وهذه طريقة اخرى للتأكد بأن الكائن المذكور في الكود لا يوجد في النموذج : فعندك خيارين للحل: 2. يا انك تُبقي الكود كما هو ، وتغيّر اسم حاوية النموذج الفرعي الى : . 2. او انك تُبقي على اسم حاوية النموذج الفرعي كما هي ، وعليه يتغيّر الكود الى : . ولاحظت انه عندك نفس الكائن بعدة مسميات ، فانت تلخبط نفسك ، وستكون المشكلة اكبر في المستقبل لما تريد عمل اي تعديل !! اعطيه نفس اسم النموذج ، والسلام : . ونصيحة اخرى ، وهي تنسيق الكود ، فلما يكون الكود كله يبدأ من اول السطر ، فلا تعرف بداية ونهاية كل مجموعة ، بينما لما يكون منسّق هكذا ، فمن السهل معرفة البداية والنهاية بمجرد النظر في الكود ، ولا داعي لقراءة الكود لمعرفة بدايته ونهايته ، هكذا : Private Sub Form_Load() If DCount("*", "Tbl_bb", "م") < 1 Then Me![addnew].Enabled = True Me.Next.Enabled = False Me.previous.Enabled = False Me.dlet.Enabled = False Me![cmdcols].Enabled = True Me![Edit].Enabled = False Me![sav].Enabled = False Me![traghh].Enabled = False AllowAdditions = True AllowEdits = False AllowDeletions = False Me.tbl_promotion.Form.AllowEdits = False Me.tbl_promotion.Form.AllowDeletions = False Me.tbl_promotion.Form.AllowAdditions = False Me.tbl_Retr.Form.AllowEdits = False Me.tbl_Retr.Form.AllowDeletions = False Me.tbl_Retr.Form.AllowAdditions = False Me.tbl_dece.Form.AllowEdits = False Me.tbl_dece.Form.AllowDeletions = False Me.tbl_dece.Form.AllowAdditions = False End If End Sub جعفر
    2 points
  48. وعليكم السلام انا معلم ويهمني هذا الموضوع لذلك قمت بتصميم برنامج يوزع المعلمين علي قاعات الامتحان وسميته برنامج الملاحظة علي الامتحانات مع مراعاة ان كل معلم يدخل كل قاعة مرة واحدة بقدر الامكان تستطيع وضع مشرف لكل مادة بحيث يتم استيعادة من الملاحظة تستطيع وضع الاحتياط تستطيع وضع لجنة لجمع وترتيب الاوراق تستطيع وضع لجنة نظام تستطيع اعفاء بعض المعلمين من الملاحظة... الخ الخ ثم في النهاية طباعة الجداول المختلفة لا اطيل عليك فهناك ميزات اخري في اليرنامج تفضل جربه لعله يناسبك 1076052452_5.5.xlsm
    2 points


×
×
  • Create New...

Important Information