نجوم المشاركات

طيب ... تفضل ... Dim rst As Recordset '' Dim ast_1, ast_3, ast_4, ast_10, ast_11, ast_12, ast_t, cast_1 As Integer Set rst = CurrentDb.OpenRecordset("tb_mbd", dbOpenDynaset) With rst .MoveFirst Do While Not .EOF .Edit If rst!case_cod.Value = 1 Or rst!case_cod.Value = 2 Or rst!case_cod.Value = 4 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 6 rst!m_es_4.Value = rst!m_bg1 * 0 rst!m_es_10.Value = rst!m_bg1 * 0 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 3 Or rst!case_cod.Value = 5 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 6 rst!m_es_4.Value = rst!m_bg1 rst!m_es_10.Value = rst!m_bg1 * 0 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 * 0 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 6 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 5 rst!m_es_4.Value = rst!m_bg1 rst!m_es_10.Value = rst!m_bg1 * 0 rst!m_es_11.Value = rst!m_bg1 * 2 rst!m_es_12.Value = rst!m_bg1 * 0 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 7 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 5 rst!m_es_4.Value = rst!m_bg1 * 0 rst!m_es_10.Value = rst!m_bg1 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If If rst!case_cod.Value = 8 Then rst!m_es_1.Value = rst!m_bg1 rst!m_es_3.Value = rst!m_bg1 * 5 rst!m_es_4.Value = rst!m_bg1 * 0 rst!m_es_10.Value = rst!m_bg1 rst!m_es_11.Value = rst!m_bg1 rst!m_es_12.Value = rst!m_bg1 * 0 rst!m_es_t.Value = rst!m_bg1 'Form.Refrm_esh End If .Update .MoveNext Loop End With '' Call t rst.close MsgBox "تم التحديث"

اتفضل يا سيدى غير الاكواد داخل الموديول بتلك الاكودا التعديل يتوافق للعمل على كلتا النواتان 32 , 64 انا الان قمت بالتجربة على 64 برجاء التجربة على 32 وموافتنا بالنتيجة #If VBA7 Or Win64 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr #Else Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook as long, ByVal ncode as long, ByVal wParam as long, lParam As Any) as long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) as long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook as long) as long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg as long, ByVal nIDDlgItem as long, ByVal wMsg as long, ByVal wParam as long, ByVal lParam as long) as long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd as long, ByVal lpClassName As String, ByVal nMaxCount as long) as long Private Declare Function GetCurrentThreadId Lib "kernel32" () as long #End If 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 #If VBA7 Or Win64 Then Private hHook As LongPtr #Else Private hHook As Long #End If Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Dim RetVal Dim strClassName As String Dim lngBuffer As LongPtr If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String On Error GoTo ExitProperly Dim lngModHwnd As LongPtr Dim lngThreadID As LongPtr lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook ExitProperly: UnhookWindowsHookEx hHook End Function -------------------------------------------------------- للاسف مش دايما بيكون ده التعديل وبس شوف الكود وانت تعرف الفرق وغير انت الملف القديم وجربه مش راح يشتغل وهذا مرفق التطبيق بعد التعديل DeleteWithPassword.accdb

وانت في صحة وسلامة ...... اخي خالد ... دقق في البيانات هل هذه النتيجة هي المطلوبة ,,,

السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد عمل معرف خاص بنا برمجيا طبعا يختلف الكود تبعا لاسم الجدول والحقل ونوع الحقل اليوم سوف اقدم لكم فكرتى المتواضعة فى تلك الوظيفة التى يمكن وضعها فى وحدة نمطية ليمكن -استدعاؤها فى زوايا التطبيق المختلفة بكل سهولة -امكانية التحكم اثناء استدعاء الوظيفة فى البادئة ان اردت اضافة بادئة ما -التحكم فى موعد اعادة التعيين ليبدأ العدد من الرقم 1 مرة أخرى سنويا او شهريا او يوميا الكوووووود '|---10/04/2022______________________________________________| '|___www.officena.net________________________________________| '| | '| _ +-----------officena-----------+ _ | '| /o) | ||||| | (o\ | '| / / | @(~O^O~)@ | \ \ | '| ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| (\\\ \_/ / \ \_/ ///) | '| \ / \ / | '| \____/________Mohammed Essam________\____/ | '| | '| 10/04/2022 | '| | '|_____www.officena.net______________________________________| '|_____Thank you for visiting https://www.officena.net_______| '======Control in Special increment prefix ID===============================================================================================================================' ' ____ __ ____ ____ __ ____ ____ __ ____ ______ _______ _______ __ ______ _______ .__ __. ___ .__ __. _______ .___________. ' ' \ \ / \ / / \ \ / \ / / \ \ / \ / / / __ \ | ____|| ____|| | / || ____|| \ | | / \ | \ | | | ____|| | ' ' \ \/ \/ / \ \/ \/ / \ \/ \/ / | | | | | |__ | |__ | | | ,----'| |__ | \| | / ^ \ | \| | | |__ `---| |----` ' ' \ / \ / \ / | | | | | __| | __| | | | | | __| | . ` | / /_\ \ | . ` | | __| | | ' ' \ /\ / \ /\ / \ /\ / __| `--' | | | | | | | | `----.| |____ | |\ | / _____ \ __| |\ | | |____ | | ' ' \__/ \__/ \__/ \__/ \__/ \__/ (__)\______/ |__| |__| |__| \______||_______||__| \__| /__/ \__\ (__)__| \__| |_______| |__| ' ' ' '===========================================================================================================================================================================' Function MySpid( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ Optional strPrefixe As String = vbNullString, _ Optional strResetYYorMMorDD As String = "YY", _ Optional nDay As Integer = 0, _ Optional nMonth As Integer = 0, _ Optional nYear As Integer = 0) As String Dim strLinkCriteria As String Dim strOldID As String Dim strNxtID As Long Dim intLenPrefixe As Integer Const intNumberOfZeros = 6 intLenPrefixe = Len(strPrefixe) + 1 If nDay = 0 Then nDay = Format(Date, "dd") If nMonth = 0 Then nMonth = Format(Date, "mm") If nYear = 0 Then nYear = Year(Date) - 2000 Select Case strResetYYorMMorDD Case Is = "YY": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 6), 2), 0) = nYear ' Yearly Reset Case Is = "MM": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 4), 2), 0) = nMonth ' Monthly Reset Case Is = "DD": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 2), 2), 0) = nDay ' Daily Reset End Select strOldID = Nz(DLast("" & strFieldName & "", strTableName, strLinkCriteria), 0) strNxtID = CLng(Right(strOldID, intNumberOfZeros)) strNxtID = strNxtID + 1 MySpid = strPrefixe & Format(nDay, "00") & Format(nMonth, "00") & Format(nYear, "00") & _ String(intNumberOfZeros - Len(CStr(strNxtID)), "0") & CStr(strNxtID) End Function يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى MySpid("FldName", "TblName") فى هذه الحالة يتم اعادة تعيين الترقيم سنويا ------------ ولكن للتحكم الكامل ولتغيير الاعدادات MySpid("FldName", "TblName", "AnyPrefixe", "yy or MM OR DD","DayDate","MonthDate","YearDate") AnyPrefixe البادئة التى تريد أن تبدأ الترقيم بها غيرها كما تريد MySpid("FldName", "TblName", "AnyPrefixe") yy or MM OR DD لو اردت اعادة تعيين الترقيم سنويا سوف تكون yy وبدون استخدام هذا الجزء هذا هو الاحتيار المفضل تبعا للكود MySpid("FldName", "TblName", "AnyPrefixe", "yy") لو اردت اعادة تعيين الترقيم شهريا سوف تكون MM MySpid("FldName", "TblName", "AnyPrefixe", "MM") لو اردت اعادة تعيين الترقيم يوميا سوف تكون DD MySpid("FldName", "TblName", "AnyPrefixe", "DD") --------- DayDate لتبدأ الترقيم من خلال رقم يوم محدد يعنى مثلا لو اردنا الترقيم يبدا من يوم 23 MonthDate لتبدأ الترقيم من خلال رقم شهر محدد يعنى مثلا لو اردنا الترقيم يبدا من شهر 09 YearDate لتبدأ الترقيم من خلال رقم سنه محدد يعنى مثلا لو اردنا الترقيم يبدا من عام 21 اجمل الامنيات بالاستمتاع مع هذا الكود وهذه الافكار هذا الاصدار الاول من كتابتى للكود لم اتمكن من التجربة بشكل كبير.. فضلا وكرما موافاتنا بالنتيجة فى حالة حدوث اى خطأ Special increment prefix ID.accdb

Sub Test() Dim ws As Worksheet, sh As Worksheet, rRange As Range, rCell As Range, rng As Range, t As Double, iRow As Long, r As Long, c As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(2) 'Tasks Set sh = ThisWorkbook.Worksheets(1) 'Summary iRow = 4: r = iRow With sh.Rows(iRow + 1 & ":" & Rows.Count) .ClearContents: .Borders.Value = 0 End With Set rRange = ws.Range("B5:B" & ws.Cells(Rows.Count, "B").End(xlUp).Row) Set rCell = rRange.Cells(1, 1) Do If rCell.Value = Chr(199) & Chr(225) & Chr(199) & Chr(204) & Chr(227) & Chr(199) & Chr(225) & Chr(237) Or rCell.Value = Empty Then GoTo NXT r = r + 1: t = 0 sh.Cells(r, 1).Value = r - iRow sh.Cells(r, 2).Value = rCell.Value For c = 3 To 16 Set rng = rCell.Offset(, c - 2).Resize(rCell.MergeArea.Rows.Count) t = Application.WorksheetFunction.Sum(rng) If t = 0 Then sh.Cells(r, c).Value = Empty Else sh.Cells(r, c).Value = t Next c NXT: Set rCell = rCell.Offset(1, 0) Set rng = Nothing Loop Until (rCell.Row > (rRange.Row + rRange.Rows.Count - 1)) With sh.Rows(iRow + 1 & ":" & r) .Borders.Value = 1 End With Application.ScreenUpdating = True End Sub

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

هذه المتغييرات للإعلان عن ان المكتبة المستخدم هي الاكسل نوع التطبيق - الصفحة - الورقة Dim xlApp As Excel.Application ' التطبيق Dim xlWb As Excel.Workbook ' الملف Dim xlWs As Excel.Worksheet ' الورقة بعد الاعلان عن المتغييرات كإجراءات بإننا سوف نقوم باستخدام وظيفة محددة يجب تزويد المكتبة او الوظيفة ببعض المعطيات كمسار ملف الاكسل Set xlWb = xlApp.Workbooks.Open("مسار ملف الاكسل") Set xlWs = xlWb.Worksheets(1) ' رقم الورقة داخل ملف الاكسل بعد فتح الملف الآن ما ذا تريد ان تفعل من خلال التالي تستطيع التعامل مع الخلية داخل الورقة x= رقم السطر y= رقم العمود xlWs.Cells(x, Y).Value التطبيق xlWs.Cells(1, 1).Value هذا باختصار شرح اساسيات الكود

الاخوة الافاضل برجاء كل من لديه اضافات الي الاكسيل ( Add Ins ) يرفقها بالموضوع للاستفادة من هذه الاضافات التي تسهل كثيرا في العمل علي الاكسيل مرسل لكم اضافة لدي و هي الماجيك فورم MasNoPass.rar

تمام استاذنا الفاضل / kanory وألف شكر لك وكل عام وانتم بخير مرة أخرى

اعتقد كده قدامك غير طريقة المهندس قاسم @Eng.Qassim فاتورة الارجاع تشبه فاتورة المشتريات .. بمعنى انك ستظيف مواد للمخزن ودفع مبالغها من الرصيد لديك هتعمل نموذج مثل المشتريات وتعمل لها مرجع على الفاتورة ال فيها الاسترجاع بحيث تأخذ اسعارها وكمياتها من الفاتوره نفسها وليس المستودع بمعني لو فى الفاتورة يوجد عدد 10 اقلام بسعر 1 دولار للفلم هنا لما تعمل استرجاع يكون مصدر البيانات معه من الفاتورة (رقم الفاتوره) وبهذا تضمن عدم استرجاع كميات اكبر من الكميات ال فى الفاتورة وايضا السعر هيكون نفسه ال فى الفاتوره وتسمع معاه فى رصيد الزبون ان تخصم مبلغ الاسترجاع معاه وبكده هيظهر معاك فى قائمة الحسابات (كشف الحساب)الخاص بالزبون ان هناك حركة شراء وحركة مرتجع

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

شاهد المرفق اخي لعل وعسي يكون هو المطلوب ملاحظة: اذا اردت اضافة بعد الحسابات الي قائمة المجموعة الفرعية1 في شيت Chart2022 اضفهم اسفل المجموعة الفرعية1 او اعد ترتيبهم الترحيل.xlsb

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

عدل على الكود باضافة كلمة PtrSafe بين Declare Function حتي يصبح الكود بهذا الشكل Private Declare PtrSafe Function

هل كانت هذه المعلومة مفيدة؟!.

يتم الاضافة عن طريق الاكسيل من خلال الطريقة الاتية نفتح شيت الاكسيل file options Add-Ins في الاسفل يوجد خانة GO Browser ثم نختار المسار الذي به الاضافة و نضغط OK انما بخصوص الاستفادة فلكل اداة فائدة مختلفة و لكن المعظم يتم من خلالها المساعدة في تسهيل الاوامر بدل عمل الاكواد ولابد من تجربتها لكي تعرف كل اداة وفائدتها تـــــم تعديل الملف The-Magic-Form.rar

وعليكم السلام ورحمة الله وبركاتة يرجي شرح المطلوب بطريقة اوضح مثلاً اين عدد المرضي المراد توزيعهم علي الغرف؟ ---------- واين يكن موجود الفردي -والزوجي؟ جزاك الله خيراً

السلام عليكم ورحمة الله وبركاته من File>>Options>>Advanced>>Show sheet tabs تلغي التحقق من خانة التحقق كما في الصورة أدناه.

السلام عليكم ورحمة الله وبركاته إليك ما طلبت أخي الكريم تقبل تحياتي نمؤذج.xlsx

السلام عليكم ورحمة الله وبركاته ما شاء الله بارك الله أخي الحبيب @lionheart حل رائع ، مذهل ، أحسنتم بارك الله بكم تقبل تحياتي العطرة لشخصكم الكريم. والسلام عليكم ورحمة الله وبركاته

والجواب حسنا سنضيف اليه مسج التاكيدية نعم , بواسطة هذا موديول '---------------------------------- 'API CONSTANTS FOR PRIVATE INPUTBOX '---------------------------------- Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long '---------------------------------- 'PRIVATE PASSWORDS FOR INPUTBOX '---------------------------------- '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'March 2003 '//////////////////////////////////////////////////////////////////// Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Function InputBoxDK(Prompt, Title) 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) UnhookWindowsHookEx hHook End Function وفي خلف الزر الحذف سنكتب هكذا Private Sub BtnDelete_Click() If Me.NewRecord = True Then Exit Sub Dim MyPass, MyId MyPass = InputBoxDK("للحذف السجل اكتب رقم سري الخاص بالحذف السجلات", "تأكيد الحذف") If MyPass = 9999 Then MyId = Me.ID If MsgBox("هل انت متأكد من حذف السجل" & " ( " & MyId & " ) " & "؟ عند اختيار ( نعم ) لا يمكنك الرجوع عنه ", vbYesNo, "رسالة تأكيدية") = vbYes Then DoCmd.SetWarnings False DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True MsgBox "تم حذف السجل رقم " & " ( " & MyId & " ) " & "بنجاح" Else MsgBox "تم الغاء العملية الحذف " End If ElseIf Len(MyPass & "") = 0 Then MsgBox "تم الغاء العملية الحذف" Else MsgBox "خطأ في رقم سري الخاص لحذف السجلات" End If End Sub واليكم المرفق DeleteWithPassword.accdb

مساعدة كود ترحيل من الفورم الى اكثر من صفحة بحسب رقم اللوحة فى اليوزر فورم test.xlsm

اخي يجب عليك استخدام اله البحث فيوجد الكثير مايشابه طلبك جزاك الله خيرا

ما شاء الله على البركة الله ينفع بك عباده

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

السلام عليكم ورحمة الله وبركاته لإجراء اللصق في الخلايا المصفاة أو ما يجاورها، نذهب إلى أعلى خلية في المكان المراد اللصق فيه مثلاً D2 من D2 :D10 نكتب فيها = أول خلية مراد نسخها مثلاً: =A2 = أول خلية مراد نسخها ثم نحدد النطاق المراد اللصق فيه على أن تكون أول خلية محددة D2 ثم نضغط على زري CTRL+Enter معاً. والله أعلم لمزيد من المعلومات يمكنك متابعة هذا الفيديو والسلام عليكم

تفضل استخدم هذا الكود في آخر محرر الأكواد الصق الكود التالي Public Function SetProdact(Barcod As String, SetCoulmin As String) Dim db As DAO.Database, rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset(" SELECT * FROM [المخزن] where [رقم_الباركود] Like '*" & Barcod & "*'") SetProdact = rs.Fields(SetCoulmin) rs.Close Set rs = Nothing End Function و في مربع اسم الصنف الصق التالي =SetProdact(Text420, "الصنف") 2.zip

السلام عليكم ورحمة الله وبركاته أخي الكريم كنت وضعت موديول التصفية ضمن حدث الورقة، بمجرد اختيار اسم المحافظة في الخلية الملونة بالأصفر H2 وهي الخلية التي تم استخدام قائمة منسدلة بأسماء المحافظات في مصر الشقيقة سيتم تلقائياً تصفية الأسماء في العمود D وأنا مستغرب كيف تم حذف موضوع استهلك جهداً ووقتاً ...فإن أمكن أن يقوم الإخوة من فريق الموقع الكرام مشكورين على إضافة هذه المشاركة إلى الموضوع السابق ثم حذف هذا الموضوع علماً أنه قد يكون السبب في حذف أحدهما راجع إلى كتابة الموضوع ذاته من العضو ذاته بنفس الوقت والتاريخ مما يخالف قوانين المنتدى الكريم ، لكن استغرابي هو كيف يتم حذف موضوع فيه ردود عديدة منها رد للأستاذ الكريم @نزار سليمان عيد جزاه الله خيراً وترك الآخر الذي لم يحظ بأية إجابة قط سوى هذه ، وأنا لا أضع اللوم كلياً على السائل فقد يكون ضعف الإنترنت هو السبب والضغط على حفظ أو إضافة لأكثر من مرة ويستجيب الموقع في كل منهما لإضافة الموضوع ذاته. والسلام عليكم. واجه بعض الاخوة مشاكل فى الدخول ، و اشار البعض الي فقدان بعض الردود و بمراجعة السبب ، تبين ان شركة الاستضافة قامت باجراء احادى الجانب دون موافقة مني بنقل الداتا سنتر الى سيرفر جديد أول أمس فى العادي كان يتم التواصل معي و اقوم بايقاف المنتدى، و لكن الان فقط اضافوا اشعار فى لوحة التحكم بانه سيتم النقل فورا ، و قد تم النقل حاليا بالفعل و لم يتم انتظار موافقتي كما هو معتاد . جاري التواص معهم لمعرفة مدى اضطرارهم الي ذلك ، ودراسة امكانية نقل الردود التي فقدت الى قاعدة البيانات

السلام عليكم تجد ضالتك بإذن الله في الملف المرفق... Ek_4.xlsm

الموضوع فى غاية الاهمية لكل مبرمج ـ ياريت كل من يهتم بهذا الموضوع يدخل ويقول ان مهتم او يهمه هذا الموضوع حتى نلفت نظر جميع الخبراء

تحياتي لكم لا يمكن ذلك الا بعمود مساعد ويكون استخراج النوع بالكود حتى لايكون هناك معادلات ومن ثم تفرز على هذا العمود شكرا لكم

أساتذتى الكبار أخوتى وأخواتى فى منتدى أوفيسنا أنا فخور انى أحد أعضاء المنتدى الكريم ده دائما ما نجد ضالتنا فيه لقيت الملف ده على موقع أجنبى وبصراحه عجبنى وحبيت أشارك بيه أحلى طاقم عمل فى المنتدى الى أن يتم شرحه وتفكيكه من عباقرة المنتدى مرفق ومنتظر اراءكم يارب يعجبكم New-Userform-.rar