Shivan Rekany

اليكي هذا قمت بتعديل النموذج من حيث التصميم واضافة كومبوبوكس للبحث معلةمات الملاك.accdb

تعرف ما هو الخطأ عندك القي نظرتا الى الكود Private Sub أمر26_Click() On Error GoTo ErrorHandler Dim fs, cf, strFolder strFolder = "E:\الرواتب" & Format(Now(), " dd-mm-yyyy ") ' اريد ان يظهر بجانب اسم المجلد تاريخ اليوم لكن هذا الكود لايعمل Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) End If Dim strReport As String Dim strFileName As String strReport = "report" strFileName = "E:\الرواتب\رواتب الموظفين" & Format(Now(), " dd-mm-yyyy ") & ".pdf" DoCmd.OutputTo acOutputReport, strReport, acFormatPDF, strFileName, False MsgBox " تم حفظ تقرير الرواتب " & Format(Now(), " dd-mm-yyyy "), vbInformation, " E - تم الحفظ في القسم" Exit Sub ErrorHandler: MsgBox "لم يتم حفظ التقرير رجاءا", 16, " تنبيه " End Sub القي نظرتا الى هذه الجملة فيه ليس هناك اي مشكلة و بيعمل لك الفولدر هكذا strFolder = "E:\الرواتب" & Format(Now(), " dd-mm-yyyy ") لكن حضرتك بيقول اعمل تقرير في هذا الفولدر strFileName = "E:\الرواتب\رواتب الموظفين" & Format(Now(), " dd-mm-yyyy ") & ".pdf" اي قرص اي في فولدر "E:\الرواتب\رواتب الموظفين" وليس هناك فولدر باسم رواتب الموظفين اي اذا يجب ان تعمل فولد رواتب الموظفين ايضا كما تعمل فولدر الرواتب او يجب ان تحذف رواتب الموظفين

هناك مشكلة واحدة وهو صناديق كل الاصناف ليس لديهم فقط 8 دزينة ( علبة ) اي هناك احتمال رقم اكبر او اقل و كل دزينة ( علبة ) احتما يكون فيها اكثر او اقل من 12 قطعة لكن اذا رأيت هذا الموضوع مهمة و سأل عنه راح اعمل مثال للتجربة و اشرح عن كيفية العمل باذن الله

تم الجواب على كل النقاط الاعلاه من قبل استاذ @kanory ويتم عمل الفولدر و التقرير في مجلد E وتقدر تتغيره الى اي مكان تريد

اذا كان قصدك عندك عدد الحبات مثلا وتريد تعرف كم يكون عدد الصناديق و الدزينة بشرط ان كل صندوق يساوي 8 دزينة و كل دزينة يساوي 12 حبة - قطعة اليك هذا استعلام SELECT Tbl_Items.ID, Tbl_Items.Name, Tbl_Items.T_Qty, Int(Int([T_Qty]\8)\12) AS Box, Int(([T_Qty] Mod (12*8))\12) AS [Set], Int(([T_Qty] Mod (12*8)))-([Set]*12) AS Pcs FROM Tbl_Items; واليك المثال بعد تعديل قبل يومين كان اريد ان افتح موضوع على هذا و اشرح لكن قلت موضوع غير مثير للاهتمام تفضل اليك المثال Filling boxes.rar

استأذن من استاذ @kanory اذا تريد ان يكون يضاف 5 سنوات كل مرة بدل سنة واحدة اتفضل اليك هذا Private Sub أمر24_Click() On Error GoTo g: On Error Resume Next Dim i As Integer Dim X As Date Dim DATE_POST As Date Dim MyYear As Integer DoCmd.GoToRecord , , acNewRec For i = 0 To Forms![test1]![no] - 1 MyYear = i * 5 Me.serial = Forms![test1]![serial] Me.date1 = DateAdd("yyyy", MyYear, Forms![test1]![Date_M]) Me.no = DateAdd("D", i, Forms![test1]![no1]) DoCmd.GoToRecord , , acNext 'On Error Resume Next Next g: Exit Sub End Sub test2000.mdb

الفيديو يقول ان بدون استخدام اي برامج !! العملية يعمل بدون اي برامج لکن اظن ان هناك ناقص خطوة واحدة انا جربت وكان مظبوط

اتفضل تم استخدام الكود في هذا الرابط لعمل نسخة احتياطي و ضغط و اصلاح وهذا هو الكود في وحدة النمطية Option Compare Database 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 وفي نموذج عند تايمر تم استخدام هذا الكود Option Compare Database Private Sub Form_Open(Cancel As Integer) Me.TimerInterval = 1000 End Sub Private Sub Form_Timer() Me.MyOclock.Caption = Time If Time = #3:00:00 PM# And Weekday(Date) = 2 Then Call BackUpMyDb: Call CopactMyDb End Sub وتقدر تغير ساعة او اليوم للتجربة عليه للعلم ليوم الاحد رقم 1 الاثنين رقم 2 الثلاثاء رقم 3 الاربعاء رقم 4 الخميس رقم 5 الجمعة رقم 6 السبت رقم 7 لكن يجب ان يكون النموذج مفتوحة في ذلك الوقت ولكن حسب رأيي الرابط الاعلاه راح تستفيد منه اليك القاعدة compactInClose (1).accdb

تقدر تفتح القاعدة لكن التعديل على التقارير و النماذج او اكواد لا

كيف لا يظهر اي قيمة اليك فيديو 2018-10-04_15-58-55.rar اعتذر ما رأيت مشاركتك حتى بعد اضافة هذه المشاركة تقبل تحياتي

استأذن من استاذنا ابو خليل يعني هذا ما تريده لانك كتبت هذا اتفضل اليك ما طلبت Private Sub barcod_DblClick(Cancel As Integer) Static i, NewBarcod, OldBarcod OldBarcod = Me.barcod If IsNull(barcod) = True Then i = 0 ElseIf NewBarcod = OldBarcod Then i = i + 1 Else i = 1 End If NewBarcod = Me.barcod ss = i End Sub sami.accdb

قبل الان انا رديت عليك هكذا والان عملت لك هذا test 15 (1).rar

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

اذا الحقول محددة كل مرة اعمل استعلام بالحقول المطلوبة واحفظه باسم QForExport واستخدم هذا السطر من الكود فقط DoCmd.OutputTo acOutputQuery, "QForExport", acViewPreview

ليس من المهم اي قاعدة تشتغل عندك المهم توصل للحل كما حضرتك تريد عندي بيشتغل كلا القاعين وبدون اي مشاكل اتفضل تم استخدام هذه الاكواد Private Sub ChooseField_AfterUpdate() If Not IsNull(Me.ChooseField) = True Then If Len(Me.TxtForQuery & vbNullString) > 6 Then Me.TxtForQuery = Me.TxtForQuery & " " & "," & Me.ChooseTble & "." Me.TxtForQuery = Me.TxtForQuery & Me.ChooseField Else Me.TxtForQuery = Me.TxtForQuery & " " & Me.ChooseTble & "." & Me.ChooseField End If Me.EndForQuery.Enabled = True End If Me.ChooseField.RemoveItem (Me.ChooseField) End Sub Private Sub ChooseTble_AfterUpdate() Set db = CurrentDb Set Td = db.TableDefs(Me.ChooseTble) Me.ChooseField.RowSource = "" Me.ChooseField.AddItem ("اسماء الحقول") For Each fld In Td.Fields If fld.Type = 4 And fld.Attributes = 17 Then Me.ChooseField.AddItem (fld.Name) Else Me.ChooseField.AddItem (fld.Name) End If Next End Sub Private Sub EndForQuery_Click() On Error Resume Next Dim CountStrTbl As Integer CountStrTbl = Len(Me.ChooseTble) Me.ExportTo.Enabled = True If Left(Me.TxtForQuery, CountStrTbl) = Me.ChooseTble Then Exit Sub Me.TxtForQuery = Me.TxtForQuery & " From " & Me.ChooseTble Me.EndForQuery.Enabled = False End Sub Private Sub ExportTo_Click() On Error Resume Next DoCmd.DeleteObject acQuery, "QForExport" Set QFEx = CurrentDb.CreateQueryDef("QForExport", Me.TxtForQuery) DoCmd.OutputTo acOutputQuery, "QForExport", acViewPreview DoCmd.DeleteObject acQuery, "QForExport" MsgBox "تم تصدير بالنجاح" End Sub test 15 - Copy.rar

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

لكن عندي لا يظهر ذلك الرسالة شوف الفيديو 2018-10-03_19-01-45.rar تم اضافة كود استمرار وعدم توقف عند الاخطاء جرب لعله يستفيد واذا ليس هناك استفادة احذف السطرين التاليتين Me.EndForQuery.Enabled = False Me.CreateQuery.Enabled = True test 15.rar

شكرا استاذ @ابو ياسين المشولي من الاحسن ان تكتب ما تعمله لكي من يرى المشاركة قبل ان ينزل المرفق يعرف ماذا بداخله وراح نستفيد منه باسرع وقت ممكن وحلولك مظبوطة 100% ونقدر عند الضغط الزر ان نعطيه الشروط هكذا بدل ان تكتبه عند فتح التقرير DoCmd.OpenReport "Sersh_rpt", acViewReport, , "Left(Nz([ItemName],0),50) Like '*' & [Forms]![Sersh_F]![n1] & '*'" وشكرا لك

حظرتك ضغطت على الزر ثلاث اي تم كتابة From ثلاث مرات وهذا لا يجوز وانا لا اعرف كيف اقدرت ان تضغطه حاول مرة اخر ابدأ من جديد ان شاء الله لا يظهر ذلك الرسالة

اتفضل تم عمل هذا الكومبوبوكس الاول ستختار فيه الجدول المراد ان تعمل له استعلام وهذا هو مصدره SELECT msysObjects.Name FROM msysObjects WHERE (((msysObjects.Type)=1) AND ((Left([Name],2)) Not In ("~s","ms","f_"))); والكومبوبوكس الثاني هو اسماء الحقول تابع الجدول المختارة في كومبوبوكس الاول وهناك زر اخر عند انتهاء من الاختيار الحقول المطلوبة تضغطه لكي يكمل جملة الاستعلام وهناك زر اخر لكي تعمل استعلام وهناك زر اخر لتصدر الى اكسل واستخدمت هذه الاكواد لعمل ذلك Private Sub ChooseField_AfterUpdate() If Not IsNull(Me.ChooseField) = True Then If Len(Me.TxtForQuery & vbNullString) > 6 Then Me.TxtForQuery = Me.TxtForQuery & " " & "," & Me.ChooseTble & "." Me.TxtForQuery = Me.TxtForQuery & Me.ChooseField Else Me.TxtForQuery = Me.TxtForQuery & " " & Me.ChooseTble & "." & Me.ChooseField End If Me.EndForQuery.Enabled = True End If End Sub Private Sub ChooseTble_AfterUpdate() If Not IsNull(Me.ChooseTble) = True Then Me.ChooseField.RowSource = Me.ChooseTble End If Me.ChooseField = Null Me.TxtForQuery = "Select" End Sub Private Sub CreateQuery_Click() On Error Resume Next DoCmd.DeleteObject acQuery, "QForExport" Set QFEx = CurrentDb.CreateQueryDef("QForExport", Me.TxtForQuery) ' DoCmd.OpenQuery QFEx.Name Me.ExportTo.Enabled = True Me.CreateQuery.Enabled = False End Sub Private Sub EndForQuery_Click() Me.TxtForQuery = Me.TxtForQuery & " From " & Me.ChooseTble Me.EndForQuery.Enabled = False Me.CreateQuery.Enabled = True End Sub Private Sub ExportTo_Click() DoCmd.OutputTo acOutputQuery, "QForExport", acViewPreview On Error Resume Next DoCmd.DeleteObject acQuery, "QForExport" MsgBox "تم تصدير بالنجاح" End Sub اليك القاعدة بعد تعديل test 15.rar

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

هذا جيد لكي لا يشتغل على اي جهاز الا ان تعطيه رمز التسجيل وهذا ايضا جيد على الرغم ان هناك برامج لكي يلغي هذا الامر وهذا احسن اذا لا تريد ان تتحول الملف الى Accde او Mde وهذا جيد لكن حاله مثل حالة شيفت :) هذا يكفي مع الرقم الاول والثاني من زمان انا ما استخدمت هذا هناك شيء اخر مع نقطة الاول اي ربط عمل ملف مثل تيكست في احد الاماكن في الجهاز بشكل سري اي اذا فتحت البرامج وما وجدت هذه الملف سيغلق البرامج والا سيفتح اذا تم تسجيله من قبل و هناك طريقة اخرى وهو تشفير البيانات بدل اخفاء الجداول لكن هذه شيء سيبطي العمل وفي الاخير 1 و 2 و 5 و اذا تريد 6 يكفي حسب رأيي

نعم لا اظن ان هذه الطرائق صعبة ... خاصتا طريقة ديماكس + 1 او الطريقة استاذ @Khalf كل شيء عنده طرائقه الحمد لله ممكن تشوفنا ما هي طريقتك لكي نعلم ماذا تريد بالضبط لا داعي تحياتي

اذن انا بحثت واليك هذا وهذا وهذا وهذا وقائمة البحث عنه https://cse.google.ae/cse?cx=partner-pub-4958585055085854:7791406915&amp;ie=UTF-8&amp;q=ترقيم+في+النموذج&amp;sa=Search والسلام

استخدم هذا NZ(DMAX("[ID]";"NameForTable");0)+1 هناك كتير مواضيع على ذلك ابحث و خذ المعلومات