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

السلام عليكم ورحمة الله تعالى وبركاته عندما نتحدث عن توسيط النماذج والتقارير لابد من الأخذ فى الاعتبار ان خاصية PopUp لها تأثير كبير فإن كانت PopUp = True لها أكواد تقوم بعمل التوسيط للنماذج والتقارير داخل الشاشة خاصة ولا تقوم بعملها ان كانت PopUp = False والعكس كذلك واحيانا ننسى ذكر هذا الأمر عند عرض الاكواد والامثلة ولذلك تعمل عند البعض ولا تعمل عند اخرين بل واحيانا اثناء التصميم ننسى هذا الامر ايضا ومن أجل ذلك بعد البحث المرير وترتيب الأفكار بفضل الله تعالى تم دمج الأكواد حتى تعمل تبعا للخاصية PopUp ايما كان اعدادها حتى وان نسى المستخدم ذلك الامر أوحتى إن كان لا يدرى عنه شئ المرفق الاتى ان شاء الله به حل المشكلة تماما طيب ما الفرق بين عمل الاكواد مع خاصية PopUp ان كانت PopUp = True يتم توسيط داخل الشاشة نفسها تبعا لابعاد شاشة العرض نفسها مهما اختلف مقاس الشاشة اما ان كان PopUp = False يتم التوسيط داخل اطار تطبيق الاكس نفسه الاكواد كالاتى اولا كلاس ولابد ان يكون اسم الكلاس clsAutoCenter وان احببتم تغيير الاسم فيجب تعديله فى الاكواد التى تخص الموديول بنفس الاسم الجديد اولا الكلاس : clsAutoCenter '|---01/11/2021__________________________________________________________________________________________| '|___www.officena.net_______________________|___________________________________________________________| '| | | '| __ _ | _ +-----------officena-----------+ _ | '| \ `/ | | /o) | ||||| | (o\ | '| \__`! | / / | @(~O^O~)@ | \ \ | '| / ,' `-.__________________ | ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| '-'\_____ U `-. | ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| \____()-=O=O=O=O=O=[]====--) | (\\\ \_/ / \ \_/ ///) | '| `.___ ,-----,_______...-' | \ / \ / | '| / .' | \____/________Mohammed Essam________\____/ | '| / .' | | '| / .' | 01/11/2021 | '| `-' | | '|_____www.officena.net_____________________|___________________________________________________________| '|_____Thank you for visiting https://www.officena.net__________________________________________________' Option Compare Database Option Explicit Private Type RECT 'RECT structure used for API calls. Left As Long Top As Long Right As Long Bottom As Long End Type Private Type POINTAPI 'POINTAPI structure used for API calls. X As Long Y As Long End Type Private m_hWnd As Long 'Handle of the window. Private m_rctWindow As RECT 'Rectangle describing the sides of the last polled location of the window. Private Const m_ERR_INVALIDHWND = 1 Private Const m_ERR_NOPARENTWINDOW = 2 #If VBA7 Then Private Declare PtrSafe Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As LongPtr) As Long Private Declare PtrSafe Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As LongPtr, ByVal X As Long, ByVal Y As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 'Moves and resizes a window in the coordinate system of its parent window. Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWndPtr As Long, lpRect As RECT) As Long 'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates. Private Declare PtrSafe Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long 'Converts lpPoint from screen coordinates to the coordinate system of the specified client window. Private Declare PtrSafe Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As LongPtr) As Long 'Returns the handle of the parent window of the specified window. #Else Private Declare Function apiIsWindow Lib "user32" Alias "IsWindow" (ByVal hWnd As Long) As Long Private Declare Function apiMoveWindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, _ ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long 'Moves and resizes a window in the coordinate system of its parent window. Private Declare Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As RECT) As Long 'After calling, the lpRect parameter contains the RECT structure describing the sides of the window in screen coordinates. Private Declare Function apiScreenToClient Lib "user32" Alias "ScreenToClient" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long 'Converts lpPoint from screen coordinates to the coordinate system of the specified client window. Private Declare Function apiGetParent Lib "user32" Alias "GetParent" (ByVal hWnd As Long) As Long 'Returns the handle of the parent window of the specified window. #End If Private Sub RaiseError(ByVal lngErrNumber As Long, ByVal strErrDesc As String) 'Raises a user-defined error to the calling procedure. Err.Raise vbObjectError + lngErrNumber, "clFormWindow", strErrDesc End Sub Private Sub UpdateWindowRect() 'Places the current window rectangle position (in pixels, in coordinate system of parent window) in m_rctWindow. Dim ptCorner As POINTAPI If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then apiGetWindowRect m_hWnd, m_rctWindow 'm_rctWindow now holds window coordinates in screen coordinates. If Not Me.Parent Is Nothing Then 'If there is a parent window, convert top, left of window from screen coordinates to parent window coordinates. With ptCorner .X = m_rctWindow.Left .Y = m_rctWindow.Top End With apiScreenToClient Me.Parent.hWnd, ptCorner With m_rctWindow .Left = ptCorner.X .Top = ptCorner.Y End With 'If there is a parent window, convert bottom, right of window from screen coordinates to parent window coordinates. With ptCorner .X = m_rctWindow.Right .Y = m_rctWindow.Bottom End With apiScreenToClient Me.Parent.hWnd, ptCorner With m_rctWindow .Right = ptCorner.X .Bottom = ptCorner.Y End With End If Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Sub Public Property Get hWnd() As Long 'Returns the value the user has specified for the window's handle. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then hWnd = m_hWnd Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let hWnd(ByVal lngNewValue As Long) 'Sets the window to use by specifying its handle. 'Only accepts valid window handles. If lngNewValue = 0 Or apiIsWindow(lngNewValue) Then m_hWnd = lngNewValue Else RaiseError m_ERR_INVALIDHWND, "The value passed to the hWnd property is not a valid window handle." End If End Property Public Property Get Left() As Long 'Returns the current position (in pixels) of the left edge of the window in the coordinate system of its parent window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect Left = m_rctWindow.Left Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Left(ByVal lngNewValue As Long) 'Moves the window such that its left edge falls at the position indicated '(measured in pixels, in the coordinate system of its parent window). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, lngNewValue, .Top, .Right - .Left, .Bottom - .Top, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property '---------------------------------------------------- Public Property Get Top() As Long 'Returns the current position (in pixels) of the top edge of the window in the coordinate system of its parent window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect Top = m_rctWindow.Top Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Top(ByVal lngNewValue As Long) 'Moves the window such that its top edge falls at the position indicated '(measured in pixels, in the coordinate system of its parent window). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, .Left, lngNewValue, .Right - .Left, .Bottom - .Top, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property '---------------------------------------------------- Public Property Get Width() As Long 'Returns the current width (in pixels) of the window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow Width = .Right - .Left End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Width(ByVal lngNewValue As Long) 'Changes the width of the window to the value provided (in pixels). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, .Left, .Top, lngNewValue, .Bottom - .Top, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property '---------------------------------------------------- Public Property Get Height() As Long 'Returns the current height (in pixels) of the window. If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow Height = .Bottom - .Top End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Let Height(ByVal lngNewValue As Long) 'Changes the height of the window to the value provided (in pixels). If m_hWnd = 0 Or apiIsWindow(m_hWnd) Then UpdateWindowRect With m_rctWindow apiMoveWindow m_hWnd, .Left, .Top, .Right - .Left, lngNewValue, True End With Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If End Property Public Property Get Parent() As clsAutoCenter 'Returns the parent window as a clFormWindow object. 'For forms, this should be the Access MDI window. Dim fwParent As New clsAutoCenter Dim lngHWnd As Long If m_hWnd = 0 Then Set Parent = Nothing ElseIf apiIsWindow(m_hWnd) Then lngHWnd = apiGetParent(m_hWnd) fwParent.hWnd = lngHWnd Set Parent = fwParent Else RaiseError m_ERR_INVALIDHWND, "The window handle " & m_hWnd & " is no longer valid." End If Set fwParent = Nothing End Property ثانيا الموديول ولن يفرق اسم الموديول فى شئ '|---01/11/2021__________________________________________________________________________________________| '|___www.officena.net_______________________|___________________________________________________________| '| | | '| __ _ | _ +-----------officena-----------+ _ | '| \ `/ | | /o) | ||||| | (o\ | '| \__`! | / / | @(~O^O~)@ | \ \ | '| / ,' `-.__________________ | ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| '-'\_____ U `-. | ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| \____()-=O=O=O=O=O=[]====--) | (\\\ \_/ / \ \_/ ///) | '| `.___ ,-----,_______...-' | \ / \ / | '| / .' | \____/________Mohammed Essam________\____/ | '| / .' | | '| / .' | 01/11/2021 | '| `-' | | '|_____www.officena.net_____________________|___________________________________________________________| '|_____Thank you for visiting https://www.officena.net__________________________________________________' Option Compare Database Option Explicit Private Type RECT X1 As Long Y1 As Long X2 As Long Y2 As Long End Type #If VBA7 Then Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long #Else Private Declare Function GetDesktopWindow Lib "user32" () As Long Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, Rectangle As RECT) As Boolean Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long #End If Private Const WU_LOGPIXELSX = 88 Private Const WU_LOGPIXELSY = 90 ' Call CenterForm(Me) ' Call CenterReport(Me) Sub CenterForm(F As Form) If F.PopUp = False Then Dim fw As New clsAutoCenter fw.hWnd = F.hWnd With fw .Top = (.Parent.Height - .Height) / 2 .Left = (.Parent.Width - .Width) / 2 End With Set fw = Nothing ElseIf F.PopUp = True Then Dim formWidth As Long, formHeight As Long Dim MaxWidth As Long, maxHeight As Long Dim ScreenWidth As Long, ScreenHeight As Long Dim formAllMarginsHeight As Long, formAllMarginsWidth As Long GetScreenResolution ScreenWidth, ScreenHeight ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0) ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0) MaxWidth = ScreenWidth * 0.6 maxHeight = ScreenHeight * 0.9 formAllMarginsHeight = F.WindowHeight - F.Section(acDetail).Height formAllMarginsWidth = F.Width formWidth = formAllMarginsWidth formHeight = formAllMarginsHeight If formHeight < F.WindowHeight Then formHeight = F.WindowHeight End If DoCmd.MoveSize (ScreenWidth - formWidth) / 2, (ScreenHeight - formHeight) / 2, formWidth, formHeight End If End Sub Sub CenterReport(R As Report) If R.PopUp = False Then Dim fw As New clsAutoCenter fw.hWnd = R.hWnd With fw .Top = (.Parent.Height - .Height) / 2 .Left = (.Parent.Width - .Width) / 2 End With Set fw = Nothing ElseIf R.PopUp = True Then Dim ReportWidth As Long, ReportHeight As Long Dim MaxWidth As Long, maxHeight As Long Dim ScreenWidth As Long, ScreenHeight As Long Dim ReportAllMarginsHeight As Long, ReportAllMarginsWidth As Long GetScreenResolution ScreenWidth, ScreenHeight ScreenWidth = ConvertPixelsToTwips(ScreenWidth, 0) ScreenHeight = ConvertPixelsToTwips(ScreenHeight, 0) MaxWidth = ScreenWidth * 0.6 maxHeight = ScreenHeight * 0.9 ReportAllMarginsHeight = R.WindowHeight - R.Section(acDetail).Height ReportAllMarginsWidth = R.Width ReportWidth = ReportAllMarginsWidth ReportHeight = ReportAllMarginsHeight If ReportHeight < R.WindowHeight Then ReportHeight = R.WindowHeight End If DoCmd.MoveSize (ScreenWidth - ReportWidth) / 2, (ScreenHeight - ReportHeight) / 2, ReportWidth, ReportHeight End If End Sub Function ConvertTwipsToPixels(lngTwips As Long, lngDirection As Long) As Long Dim lngPixelsPerInch As Long Const nTwipsPerInch = 1440 #If VBA7 Then Dim lngDC As LongPtr #Else Dim lngDC As Long #End If lngDC = GetDC(0) If (lngDirection = 0) Then lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX) Else lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY) End If lngDC = ReleaseDC(0, lngDC) ConvertTwipsToPixels = (lngTwips / nTwipsPerInch) * lngPixelsPerInch End Function Function ConvertPixelsToTwips(lngPixels As Long, lngDirection As Long) As Long Dim lngPixelsPerInch As Long Const nTwipsPerInch = 1440 #If VBA7 Then Dim lngDC As LongPtr #Else Dim lngDC As Long #End If lngDC = GetDC(0) If (lngDirection = 0) Then lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSX) Else lngPixelsPerInch = GetDeviceCaps(lngDC, WU_LOGPIXELSY) End If lngDC = ReleaseDC(0, lngDC) ConvertPixelsToTwips = (lngPixels * nTwipsPerInch) / lngPixelsPerInch End Function Private Sub GetScreenResolution(ByRef Width As Long, ByRef Height As Long) Dim R As RECT Dim RetVal As Long #If VBA7 Then Dim hWnd As LongPtr #Else Dim hWnd As Long #End If hWnd = GetDesktopWindow() RetVal = GetWindowRect(hWnd, R) Width = R.X2 - R.X1 Height = R.Y2 - R.Y1 End Sub ويتم استدعاء كود توسيط النماذج من خلال السطر الاتى فى حدث عند الفتح Call CenterForm(Me) ويتم استدعاء كود توسيط التقارير من خلال السطر الاتى فى حدث عند الفتح Call CenterReport(Me) فى حالة كانت PopUp = True يتم توسيط النماذج والتقارير فى وسط شاشة الحاسب الالى تمام تبعا لابعاد الشاشة اما فى حالة PopUp = False يتم توسيط النماذج والتقارير فى داخل اطار برنامج الاكسس نفسه والان اليكم المرفق بالمثال العملى AutoCentre.mdb

تفضل التعديل Database3.accdb

حسب فهمي للمطلوب تم وضع معادلة لتقسيم الرقم إلى فئات العملات في الخلية T5 وسجبها في الجدول كله أفقيا ورأسيا بالتوفيق رواتب.xlsm

وهنا ستجد الكود الذي في الفيديو جاهزا ً : 🙂

اتفضل الحل Example.xlsx

لا تكتب الرقم مباشرة إعمل عملية حسابية لحساب وسط الشاشة 🙂 ( عرض الشاشة على 2 - عرض النموذج على 2 ) مثلا 🙂

اخي سعد ببساطة لتتمكن من تنفيد المطلوب ما عليك هو وضع هده الاكواد داخل OptionButton لتنشيط ورقة العمل الهدف واستبدال اسم ورقة العمل في اكواد اليوزرفورم للتعامل دائما مع ActiveSheet Private Sub OptionButton1_Click() Sheets(CStr(OptionButton1.Caption)).Activate End sub Private Sub OptionButton2_Click() Sheets(CStr(OptionButton2.Caption)).Activate End sub Private Sub OptionButton3_Click() Sheets(CStr(OptionButton3.Caption)).Activate End sub مني 2.xlsm

ليش مغربل نفسك بفلترة البيانات بالاكسل ............ ممكن تفلترها بتقرير أكسس وتفك نفسك ...... sahwal-1.rar

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

عذرا ابا جودي .. ولو تأخر اعجابي سنوات ، لا اذكر اني مررت بهذه التحفة من قبل جزاك الله خيرا على هذا الترتيب الفني البديع والمتكامل

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

سؤال مهم جدا لماذا هذا التكالب على المشاركة وصاحب المشكلة لم يرد على أي منا?؟؟؟؟؟؟؟؟

اخي الكريم ، رغم الخطأ في النموذج الا انه تفضل ان كان صحيح. فلم افهم فكرة اجمالي الواد و اجمالي الصادر المحاسبي.accdb

وعليكم السلام ورحمه الله وبركاته ضع هذا السطر في ثانى سطر في اليوزرفورم Public Sh As Worksheet ضع هذه الاسطر في السطر الثالث او اي مكان اخر كما تشاء Private Sub OptionButton1_Click() Set Sh = ThisWorkbook.Worksheets(OptionButton1.Caption) End Sub Private Sub OptionButton2_Click() Set Sh = ThisWorkbook.Worksheets(OptionButton2.Caption) End Sub Private Sub OptionButton3_Click() Set Sh = ThisWorkbook.Worksheets(OptionButton3.Caption) End Sub قم باستبدال كلمه Sheet1 بكلمة Sh في جميع اكواد اليوزر فورم

أخي الكريم بالطريقة التي تعتمدها في حفظ الملفات المرفقة ستلاحظ أنه بعد 100 صنف مثلاً سيكون حجم برنامجك كبير الى حد ما ، ولن يسمح لك الآكسيس بحجم قاعدة بيانات يتعدى الـ 2 جيجابايت ، مما سيجعل البرنامج بطيء ، وذلك لأنك اعتمدت على تخزين الملف المرفق داخل قاعدة البيانات . والأصح من الصحيح هو أن تجعل الملفات المرفقة الـ PDF تُخزن في مجلد منفصل عن القاعدة ؛ هكذا ستلاحظ الفرق في سرعة برنامجك و كفاءته . هذا من وجهة نظري طبعاً أما عن كيفية حفظ ملفات الـ PDF من المرفقات المدمجة بقاعدة البيانات فهناك طريقتين ، الأولى كالتالي صورة في المرفقات ، والطريقة الثانية عن طريق الـ VBA ولكنها ستكون مزعجة لأنها في هذا الفيديو :- ودمت بخير

شغل الكود اخى هاني سوف يجلب البيانات في العامود g والعامود h بدلا من المعادله الكود ليس له علاقه باي اكواد اخري

وعليكم السلام ورحمة الله تعالى وبركاته فقط اجعل الكود هكدا Sheets("المقبوضات").Range("A2:L2000").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("A1:D2"), CopyToRange:=Range("A4:H4"), Unique:=False وقم بجعل Criteria الخاصة بمعايير الفلترة بهدا الشكل GES1 - Copy.xlsm

اتفضل برنامج يمسح كل بيانات الشهر المحدد Database10000.accdb

تمام تم فتح امان الماكرو المستخلصات 2023.xlsm

اعتدر اخي @husain alhammadi على التاخير في الرد بسبب ضيق الوقت على العموم كما سبق الدكر مسبقا لقد حاولت تعديل الملف ليتناسب مع متطلباتك اتمنى ان يلبي المطلوب وتستفيد منه بادن الله واي استفسار لا تتردد في دكره سوف نكون سعداء دائما بحصولك على النتيجة المطلوبة تحديد صلاحيات المستخدمين.xlsb

برنامج عقارات مفتوح المصدر يمكن استخدامه الرقم السري 1975 ستجد ملف بعض الشروحات بالمجلد بعد فتح ضغط الملف ضع المجلد كاملا في c نرجو الإفادة estate.zip

شكرا لك أخي @bidheel2009 على هذه الهدية القيمة .. 🙂 أقترح عليك إضافتها لمكتبة الموقع ليسهل الرجوع إليها لم يحتاجها : https://www.officena.net/ib/files/category/5-قسم-الأكسيس/

السلام عليكم ورحمة الله وبركاته يسرني اليوم أن أقدم لكم هذه الهدية المتميزة والمتواضعة ( زاد المثابر للحصول على أسماء العناصر) هذه الأداة صممتها بفضل الله في أكسس تقوم بإحضار وسرد أسماء العناصر لك لكي تستطيع نسخها ولصقها في أي مكان تريد بكل سهولة ويسر 🙂 شخصيا أستفدت كثيرا منها وسهلت علي الكثير من الجهد وقلصت من وقت العمل بحمد الله وفضله. وهنا اختصرت على نفسي الكتابة وقمت بشرح الأداة مرئيا 🙂 متابعة ممتعة 😊👌🏼 ولا أستغني عن آراءكم وملاحظاتكم .. 🙂 لتحميل الملف المستخدم في الشرح وبه النموذج : التحديث 2.0 : تم إضافة خاصية جلب عناصر النماذج الفرعية .. والتقارير الفرعية .. شكرا للأخ @عمر ضاحى على الفكرة 🙂

بارك الله فيك أستاذنا @ابا جودى .. جهود مباركة ..

ايه رأيك يا استاذى الجليل ومعلمى القدير الاستاذ @SEMO.Pa3x أن يتم إرسال ذلك اولا للعميل بدلا من ملف VBS HWND.zip

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

الله يرضى عليك استاذي جعفر هل اكو شي اجمل من هذا الكود اوبدات يعمل بسرعة اكبر

التعديل جميل ايش رايك نقلل الكود الذي وضعته انت ، بواسطة الامر Not ، ومعناه ، غيّر القيمة الحالية الى القيمة التي ليست فيه: Dim f As Boolean Dim rst As DAO.Recordset Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount f = rst!done For i = 1 To RC rst.Edit rst!done = Not f rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing End Sub . جعفر ونعم كنت على علم بهذا ، ولكني كنت اعتقد بأن المبرمج كان سيقفل على المستخدمين تغيير الحقل يدويا ، وبالتالي تكون المشكلة تم حلها ولكن ، وحتى بالحليين (الحل الثاني الذي تركته انا في الكود الاصلي) ، وحتى الطريقة التي تفضلت بها انت ، فنحن نعتمد على قيمة اول حقل ، وربما لم يكون صحيحا ، لذا سيضطر المستخدم الى الضغط على زر التغيير مرتين (بعض الاوقات للحصول على القيمة الصحيحة) جعفر

السلام عليكم و رحمة الله تعالى و بركاته. أستأذنك أستاذ القدير جعفر في إضافة تعديل بسيط على الكود الذي قمت بتقديمة. الكود الذي كتبته أستاذي يقوم بتحديد الخانة الغير محددة و نزع التحديد عن الخانة محددة لقد أضفت تعديل بسيط ليقوم الكود بتحديد كامل الخانات أو إزالة التحديد من جميع الخانات كما طلب السائل. Dim f As String Dim rst As DAO.Recordset Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount f = rst!done For i = 1 To RC If f = "true" Then rst.Edit rst!done = False rst.Update Else rst.Edit rst!done = True rst.Update End If rst.MoveNext Next i rst.Close: Set rst = Nothing Selection.rar

وعليكم السلام تفضل Private Sub cmd_Select_All_Click() '1 ' Dim rst As DAO.Recordset ' Set rst = Me.RecordsetClone ' rst.MoveLast: rst.MoveFirst ' RC = rst.RecordCount ' ' For i = 1 To RC ' rst.Edit ' rst!done = Not rst!done ' rst.Update ' ' rst.MoveNext ' Next i ' ' rst.Close: Set rst = Nothing '2 CurrentDb.Execute ("UPDATE fatora SET done =" & Not Me.done) Me.Requery End Sub . جعفر

السلام عليكم اليك الملف بعد التعديل كانت المشكلة عندك في نموذج اذن الاضافة كارت الصنف-up.rar

تفضل يا أبو سليمان بعد فك الضغط عن المرفق سوف تجد ملفاً باسم الرئيسية ضعه فى المجلد mokhtar get data for bosoliman كن حذرا مع الملف إذ به معادلات واحتفظ بالملف المضغوط كنسخة احتياطية الشرح بعد ما تبدى رأيك تحياتى الرئسية.rar

أبوسليمان فى هذا المرفق تم تغيير امتداد الملفات الستة الى xls مع تغيير أسماء الملفات لسهولة التعامل جلبت لك البيانات من الملفات الخمس وهى مغلقة وبضغطة واحدة الى ملف الرئيسية تحديث البيانات : عدل كما تشاء فى الملفات الخمس وانقر على الزر فى الرئيسية فقط وبكده نكون عملنا المرحلة الأولى أما الثانية سوف أسألك بعض الأسئلة فى حينها أما السؤال الأن : الرقم الطويــــــــــــــــــــــــــــــــــــــــــــــل ده بيتقسم الى خلايا هل المطلوب منه أن نستخلص منه تاريخ ووقت مثلاً ؟ أرجو الايضاح وسوف نكمل الموضوع باذن الله تعالى mokhtar get data for bosoliman.rar