samisalim

راح اخذ بنصيحتك اخي ازهر بإعادة بناء قاعدة البيانات من الصفر جزاك الله خيرا

نعم قرأت موضوع الاستاذ جعفر أخي بخصوص مسميات الحقول باللغة الانجليزية له علاقه أخي العزيز

السلام عليكم ورحمة الله وبركاته عملت جزئيين للبرنامج واجهة feوجداولbe لمشاركة في السيرفر لكن بعد تشغيل البرنامج صار ثقيل وبطيء جدا وبعد البحث عن حل للمشكلة في المنتدى في مشاركة استاذنا @jjafferr اتضح إن دالة DLOOKUPهي السبب للمشكلة وبعد التفتيش في البرنامج توصلت الى وجود استعلام باسم Q1 يوجد به 3 أكواد باستخدام دالة dlookup الماركة: BRANDS: DLookUp("[BRANDS]";"[BRANDS]";"[BrID] =" & DLookUp("[BRANDS]";"[MODELS]";"[MODELS]![MOID]=" & DLookUp("[IDM]";"[DEVICE]";"[SERIAL] like '" & [EMPDEV]![IDD] & "'"))) الموديل: MODELS: DLookUp("[MODELS]";"[MODELS]";"[MOID] like '" & DLookUp("[IDM]";"[DEVICE]";"[SERIAL] like '" & [EMPDEV]![IDD] & "'") & "'") النوع: TYPE: DLookUp("[TYPE]";"[MODELS]";"[MOID] like '" & DLookUp("[IDM]";"[DEVICE]";"[SERIAL] like '" & [EMPDEV]![IDD] & "'") & "'") هل ممكن أساتذتي إن تدلوني عن كيفية حل هذه المشكلة؟ IT_v2_fe.rar

جزاك الله خيرا استاذنا القدير جعفر الكود شغال 100%

قمت بتصميم برنامج اكسس على جهازي وعند نقل الملف إلى جهاز آخر تظهر هذه الرسالة فما الحل

رفع الله مقامكم كما رفع الســــــــماء ..وتقبل منكم الصلاة والدعاء ..ووســـــع رزقكم عدد مانزل من الماء ... وطوى صحائف أعمالكم نقية بيضاء

يوجد لدي 6 مربعات للتحرير والسرد أول 3 مربعات أمورهن طيبة ويعملن بكفائة (cmbsection-cmbtype-cmbsystemS) أريد إضافة المربعات 3 المتبقية (cmbBRANDS-CMBMODELS-cmbclass) إلى كود المتغيرات Public Sub choixemp() Dim sql As String, sql1 As String, ss As String, sqf As String sql1 = "update Q1 set choix=true " If (IsNull(cmbsection)) And (IsNull(cmbtype)) And (IsNull(CmbsystemS)) Then sql = "update Q1 set choix=true " ElseIf (Not (IsNull(cmbsection))) And (Not (IsNull(cmbtype))) And (Not (IsNull(CmbsystemS))) Then sql = "update Q1 set choix=true where type= '" & cmbtype & "' and ids= " & cmbsection & " and SystemS like '" & CmbsystemS & "*'" ElseIf (IsNull(cmbsection)) And (IsNull(CmbsystemS)) Then sql = "update Q1 set choix=true where type='" & cmbtype & "' " ElseIf (IsNull(cmbtype)) And (IsNull(CmbsystemS)) Then sql = "update Q1 set choix=true where ids= " & cmbsection ElseIf (IsNull(cmbtype)) And (IsNull(cmbsection)) Then sql = "update Q1 set choix=true where SystemS like '" & CmbsystemS & "*'" ElseIf (IsNull(cmbtype)) Then sql = "update Q1 set choix=true where SystemS like '" & CmbsystemS & "*' and ids= " & cmbsection ElseIf (IsNull(CmbsystemS)) Then sql = "update Q1 set choix=true where type= '" & cmbtype & "' and ids= " & cmbsection ElseIf (IsNull(cmbsection)) Then sql = "update Q1 set choix=true where type= '" & cmbtype & "' and SystemS like '" & CmbsystemS & "*'" End If DoCmd.RunSQL sql End Sub ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Public Sub listeemp(xx As String) Dim sql As String, sql1 As String, ss As String, sqf As String sql1 = "select * from " & xx & " " If (IsNull(cmbsection)) And (IsNull(cmbtype)) And (IsNull(CmbsystemS)) Then sql = "select * from " & xx & " " ElseIf (Not (IsNull(cmbsection))) And (Not (IsNull(cmbtype))) And (Not (IsNull(CmbsystemS))) Then sql = "select * from " & xx & " where type= '" & cmbtype & "' and ids= " & cmbsection & " and SystemS like '" & CmbsystemS & "*'" ElseIf (IsNull(cmbsection)) And (IsNull(CmbsystemS)) Then sql = "select * from " & xx & " where type='" & cmbtype & "' " ElseIf (IsNull(cmbtype)) And (IsNull(CmbsystemS)) Then sql = "select * from " & xx & " where ids= " & cmbsection ElseIf (IsNull(cmbtype)) And (IsNull(cmbsection)) Then sql = "select * from " & xx & " where SystemS like '" & CmbsystemS & "*'" ElseIf (IsNull(cmbtype)) Then sql = "select * from " & xx & " where SystemS like '" & CmbsystemS & "*' and ids= " & cmbsection ElseIf (IsNull(CmbsystemS)) Then sql = "select * from " & xx & " where type= '" & cmbtype & "' and ids= " & cmbsection ElseIf (IsNull(cmbsection)) Then sql = "select * from " & xx & " where type= '" & cmbtype & "' and SystemS like '" & CmbsystemS & "*'" End If Me.RecordSource = sql DoCmd.RunSQL "update EMPDEV set choix =false" choix1.Value = False lblselect.Caption = "تحديد الكل" End Sub IT_v24_fe - Copy_0001.rar

دائرة تقنية المعلومات يوجد بها قسمي (الدعم الفني والشبكات) مثال:عند اختيار من مربع التحرير والسرد التالي 1- الدوائر = تقنية المعلومات 2 الاقسام =الدعم الفني الحين راح يظهر ناتج فرز سجلات الدعم الفني وعند الضغط على (تحديد الكل) باللون الاحمر يتم تحديد كل سجلات الموجودة في قسم الدعم الفني وهنا يوجد في قاعدة البيانات موظف واحد فقط. عند الضغط على زر الطابعة يتم طباعة جميع الاقسام في الدائرة من ضمنها قسم الشبكات كان يجب طباعة سجلات الدعم الفني فقط اتمنى يكون شرحي مفهوم.

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

تم ضبط القياسات واختفت الملاحظة تبقى في عملية الفرز

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

شكرا استاذي ولكن مربع الاختيار لايعمل بعد التعديل

تفضل أخي Test_It.rar

السلام عليكم ورحمة الله وبركاته أولا اشكر استاذي @محمد أبوعبدالله على مساعدتي في كود الفرز في الموضوعي السابق على الرابط هذا هو الكود المستخدم On Error Resume Next Dim myCriteria As String myCriteria = myCriteria & "(" myCriteria = myCriteria & "[CNAME]= '" & Me.cmbcname.Column(1) & "'" myCriteria = myCriteria & ")" Debug.Print myCriteria Me.Filter = myCriteria Me.FilterOn = True المطلوب أريد عندما أقوم بعملية الفرز وتحديد السجلات والضغط على زر الطابعة يتم طباعة السجلات المحددة فقط أي شخص لديه الحل الرجاء المساعدة Test_It.rar

جزاك الله خيرا

استاذي @د.كاف يار حاولت اطبق كود في نموذج آخر لكن مااعرف وين أخطأت وهل تبين لي الخطأ أكون شاكر لك هذا هو الكود...مع ارفاق ملف Sub Trans() On Error Resume Next Dim db As DAO.Database Dim rs, rs2 As DAO.Recordset Set rs = CurrentDb.OpenRecordset("SELECT * FROM SCDEV where Choix=-1") Set rs2 = CurrentDb.OpenRecordset("SCDEV_ARCHIVES") If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) If rs.Fields(13) = -1 Then rs2.AddNew rs2![IDED] = rs.Fields(0) rs2![IDS] = rs.Fields(1) rs2![Location] = rs.Fields(2) rs2![IDD] = rs.Fields(3) rs2![DATEG] = rs.Fields(4) rs2![STATUS] = rs.Fields(5) rs2![SystemS] = rs.Fields(6) rs2![NOTES2] = rs.Fields(7) rs2![DATER] = rs.Fields(8) rs2![RECEIPT] = rs.Fields(9) rs2![NOTES] = rs.Fields(10) rs2![IDD1] = rs.Fields(11) rs2![IDD2] = rs.Fields(12) rs2![Choix] = -1 rs2.Update rs.Delete End If rs.MoveNext Wend End If Dim sSQL As String rs.Close Set rs = Nothing DoCmd.Requery Set db = CurrentDb sSQL = "UPDATE SCDEV SET choix=false; " db.Execute sSQL End Sub Sub ExportReport() On Error Resume Next Dim fso As Object Dim fldrname As String Dim fldrpath As String Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\احلال الاجهزة" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) End If Dim DstFile As String DstFile = CurrentProject.Path & "\احلال الاجهزة\احلال الاجهزة-" & Format(Now, "dd-mm-yyyy") & "-(" & Format(Now, "hh.nn.ss") & ").pdf" DoCmd.OutputTo acOutputReport, "SCDEVMENU", "PDFFormat(*.pdf)", DstFile, True ', "", , acExportQualityPrint End Sub School_It_0001.rar

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

استاذي العزيز @د.كاف ياركفيت ووفيت وجوزيت جنة الفردوس وعيدك مبارك استاذي هل ممكن اضافة كود التصديرPdf في زر إرجاع وطباعة استمارة ويقوم بتخزين المستند بإسم احلال الاجهزة مع التاريخ مع امكانية طباعته ؟؟؟ اكون ممتن لك

تكملة لموضوعي السابق في الرابط التالي https://www.officena.net/ib/topic/109973-مساعدة-في-كود-نقل-السجلات/ وكل الشكر والتقدير للأستاذ kanory على المساعدة On Error Resume Next Me.Refresh TimerId = SetTimer(0, 0, 1, AddressOf TimerProc) str_Title = "كلمة المرور" If InputBox("ادخل كلمة المرور") <> 123 Then Cancel = True Exit Sub Else Dim i i = Me.IDED If MsgBox("هل تريد إحلال الاجهزة وطباعة الإستمارة؟", _ vbCritical + vbYesNo, _ "") = vbNo Then Exit Sub Else DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO EMPDEV_ARCHIVES ( IDED, IDE, IDD, DATEG, STATUS, SystemS, NOTES2, DATER, RECEIPT, NOTES, IDD1, IDD2 ) " & vbCrLf & _ "SELECT EMPDEV.IDED, EMPDEV.IDE, EMPDEV.IDD, EMPDEV.DATEG, EMPDEV.STATUS, EMPDEV.SystemS, EMPDEV.NOTES2, EMPDEV.DATER, EMPDEV.RECEIPT, EMPDEV.NOTES, EMPDEV.IDD1, EMPDEV.IDD2 " & vbCrLf & _ "FROM EMPDEV " & vbCrLf & _ " WHERE (((EMPDEV.Choix)=True));" DoCmd.OutputTo acOutputReport, "EMPDEVMENU", acFormatPDF, strPathAndfile, True DoCmd.RunSQL "DELETE EMPDEV.Choix, EMPDEV.* " & _ " FROM EMPDEV " & _ " WHERE (((EMPDEV.Choix)=True));" DoCmd.SetWarnings True End If End If Me.Requery end sub لكن تظهر هذه المشكلة 1-عند الضغط على OK يتم التصدير ولكن لايتم حذف السجلات المحددة في النموذج 2-عند الضغط على Cancel يتم حذف السجلات

up

الله يفضل عليك دنيا وآخرة واجهتني مشكلة 1-عند الضغط على OK يتم التصدير ولكن لايتم حذف السجلات المحددة في النموذج 2-عند الضغط على Cancel يتم حذف السجلات

On Error Resume Next Me.Refresh Dim i i = Me.IDED If MsgBox("هل تريد إرجاع جهاز وطباعة الإستمارة؟", _ vbCritical + vbYesNo, _ "") = vbNo Then Exit Sub Else DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO EMPDEV_ARCHIVES ( IDED, IDE, IDD, DATEG, STATUS, SystemS, NOTES2, DATER, RECEIPT, NOTES, IDD1, IDD2, Choix ) " & _ " SELECT EMPDEV.IDED, EMPDEV.IDE, EMPDEV.IDD, EMPDEV.DATEG, EMPDEV.STATUS, EMPDEV.SystemS, EMPDEV.NOTES2, EMPDEV.DATER, EMPDEV.RECEIPT, EMPDEV.NOTES, EMPDEV.IDD1, EMPDEV.IDD2, EMPDEV.Choix " & _ " FROM EMPDEV " & _ " WHERE (((EMPDEV.Choix)=True));" DoCmd.RunSQL "DELETE EMPDEV.Choix, EMPDEV.* " & _ " FROM EMPDEV " & _ " WHERE (((EMPDEV.Choix)=True));" DoCmd.SetWarnings True End If Me.Requery 'Me.Visible = False DoCmd.OpenReport "SCDEV_ARCHIVES", acViewPreview ', , "[IDED]=Forms![EMPDEVMENU]![IDED]", acWindowNormal DoCmd.Close acForm, Me.Name, acSaveNo 'DoCmd.OpenForm "mod1", , , "mcod=" & i اساتذتي @kanory @Eng.Qassim كيف اقدر ادمج كود تصدير البيانات مع الكود السابق DoCmd.OutputTo acOutputReport, "EMPDEVMENU", acFormatPDF, strPathAndfile, True لكي يتسنى لي حفظ نسخة من بيانات احلال الاجهزة

نعم استاذي وجزاك الله خير