jamal2080

اريد معرفة خطاء فى هذا الكود Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function يوجد خطاء فى هذا الكود :- hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) رسالة تحذير :-

اريد معرفة خطاء فى هذا الكود Private Sub hide_link_Table_Click() Dim db As Database Dim tdf As TableDef Set db = CurrentDb For Each tdf In db.TableDefs If tdf.Attributes = 1073741824 Then tdf.Attributes = 1 Next txt.Value = " تم إخفاء الجداول المرتبطة بنجاح" txt.ForeColor = 255 db.Close Set tdf = Nothing Set db = Nothing End Sub

Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function يوجد خطاء فى الكود hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

قائمة مستدلة.rar السلام عليكم رحمه الله وبركاتة انشاء قائمة منسدلة اريد منكم تعديل علية ولكم منى جزيل الشكر

تفضل اخى ابو خليل . تم تعديل على الكود ولكن اريد منكم تعديل علية ليظهر بافضل صورة test.rar

هل يوجد طريقة معينة فى تعين كود مربع النص مثل مربع السرد وتحرير انة يعمل على مربع نص غير منظم . * - اريد تعديل على مربع نص منظم

اريد منكم مساعدها هذا الكود يعمل على مربع نص غير منظم اريد تعديل على مربع نص منظم . ولكم منى جزيل الشكر والتقدير Private Sub Command10_Click() Forms![frm_RD]![k_1] = [Field1] Forms![frm_RD]![ID_descr] = [Field3] Forms![frm_RD]![Text100] = Null Forms![frm_RD]![Text102] = Null Forms![frm_RD]![Child102].Height = 0 End Sub

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

الســــــــــــــــــــــــــــــ( عليكم ورحمة الله وبركاتة )ــــــــــــــــلام اريد منكم مساعدها فى هذا الطريقة بدل من مربع سرد 1080.rar

السلام عليكيم ورحمه الله وبركاته اريد منكم مساعدة فى انشاء نمودج تسليم عهده هل إنشاء نمودج عهدة الأجهزة الحاسوبية باستخدام الخطوات التالية: - التقرير بعنوان المستند، وتاريخ العهدة، واسم الموظف أو الشخص الذي يتولى المسؤولية عن الأجهزة الحاسوبية. - بإدراج قائمة بجميع الأجهزة الحاسوبية الموجودة في العهدة، وتضمن تفاصيل كل جهاز، مثل النوع والموديل ورقم التسلسل وحالتهم الفنية الحالية. - يفضل توضيح الحالة الفنية والعامة لكل جهاز، وإذا كان هناك مشاكل تقنية معينة تؤثر على أدائه. يجب توضيح تواريخ استلام الأجهزة وتواريخ التسليم المتوقعة، بالإضافة إلى أي شروط خاصة للاستخدام أو الصيانة. يجب تضمين بنود العهدة والاستلام والتسليم، وتوقيع الموظف أو المستلم والمدير المباشر على التقرير لتأكيد أنهما قرأا التقرير ووافقا على شروطه. يمكن إضافة أية ملاحظات أو تعليقات إضافية إذا لزم الأمر. يجب عليك التحقق من أن التقرير يتوافق مع سياسات الشركة أو المؤسسة المعنية، وأنه يتضمن جميع المعلومات اللازمة. كما يمكنك الرجوع إلى شركة المحاسبة أو القانونية المعنية للحصول على المزيد من المعلومات والتوجيهات في هذا الصدد.

السلام عليكم ورحمة الله وبركاته عندى كود نمودج بحث يوجد خطا 1 - هل هناك مكتبة غير موجوده ارجوا منكم مساعدها Option Compare Database Dim Anim As clsFormAnimate Private Sub cmd_exit_Click() On Error GoTo Err_EXIT_Click DoCmd.Close Exit_EXIT_Click: Exit Sub Err_EXIT_Click: Handle_Errors_ADO "", Err.Number, Err.DESCRIPTION Resume Exit_EXIT_Click End Sub Private Sub cmd_search_Click() Dim str As String Dim str_2 As String Dim mth As Integer Dim X If GENERAL.PRVCTRL.ControlType <> acComboBox Then If Me.FLDSRH <> "" Then Select Case Me.srhtyp.Value Case "1" str = Me.FLDSRH & " = " & """" & Me.str & """" str_2 = Me.FLDSRH & " = " & Me.str Case "2" str = Me.FLDSRH & " LIKE " & """" & Me.str & "*""" Case "3" str = Me.FLDSRH & " LIKE " & """*" & Me.str & "*""" Case "4" str = Me.FLDSRH & " LIKE " & """*" & Me.str & """" End Select Else str = "1=1" End If Else X = GENERAL.PRVCTRL.RowSource X = GENERAL.PRVCTRL.Column(1) If Me.FLDSRH <> "" Then Select Case Me.srhtyp.Value Case "1" str = Me.FLDSRH & " = " & """" & Me.str & """" str_2 = Me.FLDSRH & " = " & Me.str Case "2" str = Me.FLDSRH & " LIKE " & """" & Me.str & "*""" Case "3" str = Me.FLDSRH & " LIKE " & """*" & Me.str & "*""" Case "4" str = Me.FLDSRH & " LIKE " & """*" & Me.str & """" End Select Else str = "1=1" End If End If If IsNull(Me.srhtyp.Value) Then mth = 0 Else mth = Me.srhtyp.Value End If DO_FIND str, str_2, mth DoCmd.Close acForm, "frm_find", acSaveYes End Sub Private Sub Form_Load() Dim A As Integer FLDSRH = GENERAL.PRVCTRL.Name End Sub Private Sub Form_Open(Cancel As Integer) Set Anim = New clsFormAnimate ' Set Anim.AnimationForm = Me ' Anim.FormHeight = 2500 ' Anim.FormWidth = 4900 ' Anim.FormTop = 1000 ' Anim.FormLeft = 100 ' Comment out line below if you ' want Animation when closing the Form. ' Anim.NoCloseAnimation = True ' Uncomment if you do NOT want ' Animation when the Form opens 'Anim.NoOpenAnimation = True End Sub

'Sets the border style as None. Me.textBoxExt1.BorderStyle = BorderStyle.None 'Sets the border style as FixedSingle. Me.textBoxExt1.BorderStyle = BorderStyle.FixedSingle 'Sets the border style as Fixed3D. Me.textBoxExt1.BorderStyle = BorderStyle.Fixed3D 'Sets the border raised inner and outer edges. Me.TextBoxExt3.Border3DStyle = Border3DStyle.Raised 'Sets the border raised outer edge and no inner edge. Me.TextBoxExt3.Border3DStyle = Border3DStyle.RaisedOuter 'Sets the border raised inner edge and no outer edge. Me.TextBoxExt3.Border3DStyle = Border3DStyle.RaisedInner 'Sets the edged border appearance of inner edge and outer edge. Me.TextBoxExt3.Border3DStyle = Border3DStyle.Etched 'Sets the border with no three-dimensional effects. Me.TextBoxExt3.Border3DStyle = Border3DStyle.Flat 'Sets the border with sunken inner and outer edges. Me.TextBoxExt3.Border3DStyle = Border3DStyle.Sunken 'Sets the border with sunken inner and no outer edges. Me.TextBoxExt3.Border3DStyle = Border3DStyle.SunkenInner 'Sets the border with sunken outer and no inner edges. Me.TextBoxExt3.Border3DStyle = Border3DStyle.SunkenOuter 'Draws the border outside the specified rectangle, preserving the dimension of the rectangle for drawing. Me.TextBoxExt3.Border3DStyle = Border3DStyle.Adjust 'Shows the border around the TextBoxExt. Me.textBoxExt2.BorderSides = Border3DSide.All 'Shows the border on top of the TextBoxExt. Me.textBoxExt2.BorderSides = Border3DSide.Top 'Shows the border at bottom of the TextBoxExt. Me.textBoxExt2.BorderSides = Border3DSide.Bottom 'Shows the border on left side of the TextBoxExt. Me.textBoxExt2.BorderSides = Border3DSide.Left 'Shows the border on right side of the TextBoxExt. Me.textBoxExt2.BorderSides = Border3DSide.Right 'Sets the border color when BorderStyle is set as FixedSingle. Me.textBoxExt1.BorderColor = Me.colorPickerButton1.SelectedColor هذه وحدة نمطية هل تستخدم فى الاكسس

هذا الكود هو الوحدة النمطية فى انتقال السجلات زار الامر الاول والنهاية والتالى والسابق وهذا جراء من امر السابق Function prevRcd(Frm) On Error Resume Next If Frm.Dirty Then MsgBox "تم تغيير محتويات النافذة، يرجى حفظ التغييرات أو التراجع عنها.", vbCritical, "تذكير" Else On Error GoTo ErrHandler DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70 ' انتقل إلى السجل السابق End If Exit Function ErrHandler: If Err.Number = 2105 Then MsgBox "لا يمكن الذهاب إلى السجل المطلوب", vbCritical + vbMsgBoxRight, "خطأ" End If End Function ويتم استدعاء الكود فى زار الامر السابق Call NavigationModule.prevRcd(Me) ولكن عندى مشكلة عند ضغط على زار الامر حفظ بعد التعديل او اضافة تظهر رسالة تحذير ولاتعمل ازرار انتقال السجلات وهذا الرسالة

Function FirstRcd(Frm) On Error Resume Next If Frm.Dirty = False Then On Error GoTo Err: DoCmd.GoToRecord , "", acFirst Exit Function Err: If Err.Number = 2105 Then MsgBox "لا يمكن الذهاب إلى السجل المطلوب", vbCritical + vbMsgBoxRight, "خطأ" End If Else MsgBox "تم تغيير محتويات النافذة يرجى الحفظ التغييرات", vbCritical End If End Function Function NextRcd(Frm) On Error Resume Next If Frm.Dirty = False Then On Error GoTo Err: DoCmd.GoToRecord , "", acNext Exit Function Err: If Err.Number = 2105 Then MsgBox "لا يمكن الذهاب إلى السجل المطلوب", vbCritical + vbMsgBoxRight, "خطأ" End If Else MsgBox "تم تغيير محتويات النافذة يرجى الحفظ التغييرات", vbCritical End If End Function Function prevRcd(Frm) On Error Resume Next If Frm.Dirty = False Then On Error GoTo Err: DoCmd.GoToRecord , "", acPrevious Exit Function Err: If Err.Number = 2105 Then MsgBox "لا يمكن الذهاب إلى السجل المطلوب", vbCritical + vbMsgBoxRight, "خطأ" End If Else MsgBox "تم تغيير محتويات النافذة يرجى الحفظ التغييرات", vbCritical End If End Function Function LastRcd(Frm) On Error Resume Next If Frm.Dirty = False Then On Error GoTo Err: DoCmd.GoToRecord , "", acLast Exit Function Err: If Err.Number = 2105 Then MsgBox "لا يمكن الذهاب إلى السجل المطلوب", vbCritical + vbMsgBoxRight, "خطأ" End If Else MsgBox "تم تغيير محتويات النافذة يرجى الحفظ التغييرات", vbCritical End If End Function استدعاء الامر Call NavigationModule.NextRcd(Me) هل يوجد خطاء فى الكود

السلام عليكم ورحمة الله وبركاتة هل هذا الكود يوجد خطاء هل يمكن استعمالة فى تجميع الحقول فى الجدول order_code & "." & report_No & "." & IIf(Len(Month(Received_date)) = 1, "0" & Month(Received_date), Month(Received_date)) & "." & Right(Year(Received_date),2)

شكرا اخى على اجابة ولكن لايعمل على منشى التعبير فى الجدول format

السلام عليكم وحمة الله وبركاته اريد عمل ترقيم الفاتورة بهذا الشكل RD.09980.06.23 رمز هو RD رقم الفاتورة هو 09980 شهر هو 06 السنة هو 23 مع فى جدول [order_code] & "." & [report_No] & "." & Month([Received_date]) & "." & Year([Received_date]) ظهر الترقيم بهذا طريقة RD.09980.6.2023 اريد طريقة عمل فرمات لشهر 06 والسنة 23 لكم منى جزيل الشكر

Private Sub Form_Current() 'setLabel Dim recClone As Object Dim intNewRecord As Integer If intNewRecord Then cmdfirstrec.Enabled = True cmdnextrec.Enabled = True cmdprevrec.Enabled = False cmdlastrec.Enabled = False cmd_add.Enabled = False Exit Sub Else cmd_add.Enabled = True cmdlastrec.Enabled = True End If Set recClone = Me.RecordsetClone If recClone.RecordCount = 0 Then cmdnextrec.Enabled = False cmdprevrec.Enabled = False cmdfirstrec.Enabled = False cmdlastrec.Enabled = False Else recClone.Bookmark = Me.Bookmark recClone.MovePrevious cmdfirstrec.Enabled = Not (recClone.BOF) cmdprevrec.Enabled = Not (recClone.BOF) recClone.MoveNext recClone.MoveNext cmdlastrec.Enabled = Not (recClone.EOF) cmdnextrec.Enabled = Not (recClone.EOF) recClone.MovePrevious End If Me![RecordCount] = "ÇáÓÌá " & (recClone.AbsolutePosition + 1) & " ãä " & _ DCount("[report_No]", "[receiptRD]") recClone.Close Exit_Form_Current: Exit Sub Err_Form_Current: If Err = 3021 Then cmdprevrec.Enabled = False cmdfirstrec.Enabled = False cmdnextrec.Enabled = False cmdlastrec.Enabled = False Resume Exit_Form_Current Else MsgBox Err.DESCRIPTION Resume Exit_Form_Current End If Me.Refresh End Sub عندى ضغط على زار الامر اضافة سجل تظهر رسالة خطاء فى الكود

Public Sub Handle_Errors_ADO(strFile As String, lngError As Long, InError As String) 'If lngError = 2046 Or lngError = 2110 Or lngError = 2499 Then If lngError = 2110 Or lngError = 20 Or lngError = -2147352567 _ Or lngError = 2455 Or lngError = 2424 Or lngError = 3167 _ Or lngError = 3021 Or lngError = 2499 Or lngError = 2427 Then GoTo Exit_Error_BT_Click Else Dim StrError As String Dim strSQL As String Dim rst As New ADODB.Recordset On Error GoTo Err_Error_BT_Click strSQL = "SELECT ErrMsg FROM ErrMessage where errcode=" & CStr(lngError) rst.Open strSQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic rst.MoveFirst StrError = rst.Fields(0) rst.Close ' ****************************************************** ' StrError = " ÊäÈíÉ: " & CStr(lngError) & " - " & StrError StrError = StrError Dim Msg, Style, Title, Help, Ctxt, Response, MyString If strFile = "" Then Msg = StrError Else Msg = StrError & " - " & strFile End If Style = vbOKOnly Title = " ãäÙæãÉ ÇáÇÓÊáÇã ÇáãæÇÏ ÇáãÍáíÉ" ' Define title. Response = MsgBox(Msg, Style, Title, Help, Ctxt) End If Exit_Error_BT_Click: Exit Sub Err_Error_BT_Click: MsgBox Err.DESCRIPTION Resume Exit_Error_BT_Click End Sub عندى اضافة سجل جديد يظهر errer فى سطر Dim rst As New ADODB.Recordset

الاخ :- مهندس قاسم شكر على اهتمامك لك منى كل احترام وتقدير ابحث فى المواقع وجدت كود على رسالة تنبية Option Compare Database Option Explicit Dim Anim As clsFormAnimate Dim Msg, Style, Title, Help, Ctxt, Response, MyString, mResult ------------------------------------------------------------------------ If GENERAL.PRVCTRL.name = "frm_RD" Then '------------------------------------------------- Msg = "غير مسموح بالبحث .. البحث فقط فى رقم الطلبية " Style = vbOKOnly Title = " برنامج الاستلام المواد المحلية والخارجية " Dim s As Integer s = 10 ' عدد الثواني mResult = MsgBoxPause(hwnd, Msg, Title, Style, s) '------------------------------------------------- Resume Exit_cmdfindrec_Click End If هل ممكن شرح هذا الكود

شكرا اخى ... عندما نخيار المكتبة Microsoft ActiveX Data Objects 3.6 تظهر رسالة تحذير Name conflicts with existing module, project, or object library

يوجد خطاء فى الكود Sub user_licence() Dim SER1 As Integer 'كود مستخدم Dim FRM1 As Integer 'اضافة Dim FRM2 As Integer 'تعديل Dim FRM3 As Integer 'عرض Dim FRM4 As Integer 'حذف Dim FRM5 As Integer 'طباعة Dim strSQL As String Dim rst As New ADODB.Recordset strSQL = "select * from MsysFRMsu" rst.Open strSQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic rst.MoveFirst SER1 = rst!SERu FRM1 = rst!FRM1u FRM2 = rst!FRM2u FRM3 = rst!FRM3u FRM4 = rst!FRM4u FRM5 = rst!FRM5u ' rst.Close 'حفظ و تراجع '----------- If FRM1 = 1 Or FRM2 = 1 Or FRM4 = 1 Then Me.cmdsaverec.Enabled = True Me.cmd_undo.Enabled = True Me.cmd_Undo_sub.Enabled = True Else Me.cmdsaverec.Enabled = False Me.cmd_undo.Enabled = False Me.cmd_Undo_sub.Enabled = False End If If FRM1 = 1 Or FRM2 = 1 Or FRM3 = 1 Or FRM4 = 1 Or FRM5 = 1 Then Me.cmdexitrec.Enabled = True End If 'عرض If FRM3 = 1 Then Me.cmdfindrec.Enabled = True Me.cmd_fresh.Enabled = True Me.cmdfirstrec.Enabled = True Me.cmdlastrec.Enabled = True Me.cmdnextrec.Enabled = True Me.cmdprevrec.Enabled = True Else Me.cmdfindrec.Enabled = False Me.cmd_fresh.Enabled = False Me.cmdfirstrec.Enabled = False Me.cmdlastrec.Enabled = False Me.cmdnextrec.Enabled = False Me.cmdprevrec.Enabled = False End If 'اضافة If FRM1 = 1 Then Me.cmd_add.Enabled = True Me.cmd_add_sub_emp_code.Enabled = True Else Me.cmd_add.Enabled = False Me.cmd_add_sub_emp_code.Enabled = False End If 'تعديل If FRM2 = 1 Then Me.cmd_mod.Enabled = True Else Me.cmd_mod.Enabled = True End If 'حذف If FRM4 = 1 Then Me.cmddelrec.Enabled = True Me.cmd_delsubrec.Enabled = True Else Me.cmddelrec.Enabled = False Me.cmd_delsubrec.Enabled = False End If 'طباعة If FRM5 = 1 Then Me.cmdprv.Enabled = True Else Me.cmdprv.Enabled = False End If End Sub يعطى خطاء فى هذا سطر Dim rst As New ADODB.Recordset

السلام عليكم شكر على مجهوداتكم ولكن عندى ملفين عدد السجلات كبير 1 - receiptRD هذا ملف يوجد بة اكثر من 4000 سجل 2 - subtable_Receipt هذا ملف يوجد بة اكثر من 22000 سجل ------------------------------------------------- س 1 - هل انشاء العلاقات بين الجداول يجب انا يكون بدون بيانات اما لا ؟ وشكر على حسن تعاونكم معا

شكرا اخى الفاضل ابوخليل

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