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

السلام عليكم ورحمة الله تعالى وبركاته عندما نتحدث عن توسيط النماذج والتقارير لابد من الأخذ فى الاعتبار ان خاصية 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

اذا وضعت البرنامج على الشبكة حتى يستخدمه اكثر من مستخدم ، فيجب تفكيك البرنامج الى: 1. اعمل نسختين من البرنامج: نسخة تضعها في مجلد المشاركة ، وستكون للجداول ، نسخة على كمبيوتر كل مستخدم ، وستكون للواجهة. 2. الجداول: افتح البرنامج ، واحذف جميع الكائنات ، ماعدا الجداول ، احفظ البرنامج ، ثم ضغط واصلاح ، 3. الواجهة: ولا تكون في مجلد المشاركة ، وانما على كمبيوتر كل مستخدم ، والواجهة عبارة عن جميع كائنات الاكسس ماعدا الجداول ، وتربط الجداول بالواجهة ، ثم تجعل نسخة منها على كمبيوتر كل مستخدم ، احفظ البرنامج ، ثم ضغط واصلاح. جعفر

وعليكم السلام 🙂 المبتدئ: يريد ان يعمل برنامج ، ويشتغل البرنامج حسب المطلوب ، المحترف: يريد ان يعمل برنامج ، ويشتغل البرنامج حسب المطلوب ، ثم تركيزه يصب على سرعة عمل البرنامج: تجربة قاعدة البيانات على ما لا يقل عن 10,000 سجل ، عمل العلاقات بين الجداول ، عمل فهرسة الحقول في الجداول ، وذلك بفهرسة جميع الحقول التي نعمل لها فرز او تصفية ، في اي مكان في قاعدة البيانات ، عمل فهرسة لجميع المتغيرات في محرر الاكواد ، بإستخدام Dim او Private او ... لهذه المتغيرات ، وافضل طريقة لإجبار المستخدم على العمل بها ، هو إضافة السطر الثاني: Option Explicit (طبعا بالاضافة الى السطر الاول) ، استعمال الاستعلام العادي بدلا عن استعلام الكود ، الاستفادة من وجود البيانات في النموذج ، وعمل المطلوب بها ، بدل ان يطلب البيانات مرة اخرى من الجداول بأوامر مثل Dlookup واخواتها ، وذلك لتقليل الضغط على الشبكة ، عدم استعمال الاوامر Dlookup واخواتها في الاستعلام ، إلا في حالات جدا نادرة ، واكيد اني نسيت ملاحظات اخرى 🙂 فالرد على سؤالك هو النقطة 4 🙂 جعفر

بداية دعونا نتفق طالما فكرنا فى الموضوع ده ووصلنا له اذن نريد اضافة حماية لتطبيقاتنا طالما سوف نتحدث عن الحماية فلسوف يتم ان شاء الله العمل على افكار تطبيق ذلك خطوة بعد خطوة تدريجيا للارتقاء بالتوازى برفع مستوى الحماية مع الانتهاء من التطبيق مشروحا خطوة بعد خطوة تفصيليا 1- كل اسماء الجداول والنماذج والاستعلامات والموديول التى تخص المستخدمين ونظام الحماية سوف تبدأ بالمقطع Usys حتى يتعامل معها االاكسس على انها من كائنات النظام فيخفيها اليا عن المستخدم العادى 2- تشفير / فك تشفير البيانات التى تخص تطبيق نظام الصلاحيات وبما اننا سوف نبدأ بتلك الجزئية يستوجب تقديم الشكـر والامتنان لاستاذى الجليل ومعلمى القدير الدكتور @SEMO.Pa3x لاننى ان شاء الله سوف استخدم نظام التشفير الذى تقدم به استاذى الجليل اولا ـــــــــ الروتين المستخدم فى تشفير الكلمات والذى يتم وضعه فى موديول Function Encoder(ByVal strWordDecrypt As String) As String Dim iIndex As Integer Dim iEncoder As Integer Dim iEncodedVal As Integer Randomize Encoder = "" For iIndex = 1 To Len(strWordDecrypt) Do iEncoder = Int(98 * Rnd + 89) iEncodedVal = Asc(Mid(strWordDecrypt, iIndex, 1)) Xor iEncoder Loop While iEncodedVal = 1000 Or iEncodedVal < 99 Encoder = Encoder & Chr(iEncodedVal) & Chr(iEncoder) Next iIndex End Function ويتم استدعاءه كلاتى Encoder(text) حيث ان text هو النص المراد تشفيره أو انه اسم الحقل ( تيكست بوكس , كمبو بوكس ..) المراد تشفير القيم الموجوده بهم ------------------- العملية العكسية وهى فك تشفير الكلمات واعادتها الى وضعها الطبيعى الروتين المستخدم فى فك تشفير الكلمات والذى يتم وضعه فى موديول Function Decodeder(ByVal strWordEncrypt As String) As String Dim iIndex As Integer Dim iDecodedVal As Integer Decodeder = "" For iIndex = 1 To Len(strWordEncrypt) Step 2 iDecodedVal = Asc(Mid(strWordEncrypt, iIndex, 1)) Xor Asc(Mid(strWordEncrypt, iIndex + 1, 1)) Decodeder = Decodeder & Chr(iDecodedVal) Next iIndex End Function ويتم استدعاءه كلاتى Decodeder(EncoderText) حيث ان EncoderText هو النص المشفر المراد فك تشفيره أو انه اسم الحقل ( تيكست بوكس , كمبو بوكس ..) المراد فك تشفير القيم الموجوده بهم واخيرا المرفق Encrypt&Decrypt.mdb

السلام عليكم 🙂 نصيحة ، اذا كان مصدر البيانات في شبكة ، فسيكون هذا العمل جدا بطيء ، لأنك تنادي البيانات من الجداول على كل نقرة !! وسيكون الحل ، بأن تكتب الكلمة التي تريدها ، ثم تعمل تصفية ، سواء عن طريق "حدث بعد التحديث" للحقل ، او عمل زر "البحث" 🙂 وفي كل الاحوال ، يجب ان يكون هذا الحقل مُفهرس في الجدول ، وتقوم بعملية ضغط واصلاح حتى تتم عملية الفهرسة 🙂 جعفر

بارك الله في جهودك ومثابرتك اخي العزيز @ناقل

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

بارك الله فيك ياغالي

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

السلام عليكم 🙂 في الاكسس ، السجلات التي ليس عليها التركيز ، تبدأ البيانات التي بها من اول سطر في الحقل ، ومن اول موقع (على اليمين او اليسار ، يعتمد على اتجاه الحقل) ، فعلشان نرفع بيانات الحقل ، يمكنك وضع هذا الكود على "حدث الحالي" للنموذج Find1 : Me.nassx.SetFocus Me.nassx.SelStart = InStr(Me.nassx, Forms!Book!tx1) - Len("<font color=red>") فلما تنقر على اي سجل ، سترى ان الكلمة التي تبحث عنها والمؤشرة باللون الاحمر ، اصبحت في منتصف السجل ، ويمكنك قراءة السطر (كما هي في الصورة التي ارفقتها انت). حاولت ان اتحكم في السجل الاول عند فتح النموذج ، ولكني للاسف لم افلح 😞 جعفر

الله عليك اخى الحبيب هو بالضبط ما اردته تحياتى لشخصكم الكريم

بارك الله فيك استاذنا الحبيب ابا جودي

السادة الأفاضل / عايز أفكار وحلول لمشكلة ترحيل قيمة فاتورة من خانة فواتير غير مستحقة ونسخها لخانة فواتير مستحقة عند حلول تاريخ الاستحقاق مع حذفها من عمود الفواتير الغير مستحقة Officna 2.XLSX

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

البرنامج يعمل لدي بدون مشاكل انظر .....

تفضل أخي .. فلتر.accdb

تفضل ..... فلتر.accdb

وعليكم السلام في البداية مطلبك يقول عند كتابة اي جزء من الاسم .. وبعدها تريد الاسم الذي يبدأ بالحرف فقط على كل حال انظر للمرفق فانه يظهر الاسماء التي تبدأ بنفس الحرف الاول فلتر(1).accdb

في الكود لا يوجد عندنا كائنات ، وانما: اسماء الكائنات في النموذج (مثل Me.ID) او التقرير او الجدول او الاستعلام ، وفهرسة هذه الكائنات تأتي/تُورّث من الجداول ، وينطبق عليها المادة #3 ، اوامر (مثل Docmd او Len او Split او Dlookup او ....) ، وهذه لا تفهرس ، اسماء المتغيرات ، وهذا ما تنطبق عليه المادة #4 ، وجميعها يُفهرس. بالنسبة الى برمجة الاكواد ، فأفضل طريقة لتعلمها ، هي حل المشكلة على ورقة ، سطر تحت آخر ، وبالتفصيل ، ثم تعطي كل كلمة/جملة اسم متغير (واحترافيا ، يجب ان يكون هذا الاسم يدل على نوع المتغير ، مثل User_ID ، وليس U فقط) ، ويجب ان تحصل على نفس النتائج كما كتبتها باليد 🙂 واما عن الاوامر ، فقد قام الاستاذ @صالح حمادي بجهد مميز في هذا الموضوع: جعفر

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

تفضل اخي الكريم هذا برنامج يشمل mdb و accdb مع امكانية تعطيل الشيفت لقاعدة بيانات بها باسوورد En-Dis.rar تحياتي

شكرا علي كلامك المشجع نعم حاولت ولم أستطع وربما قد نالني الارهاق ولهذا أعدك أن أستمر في المحاولة غداً والله المستعان

Sub Test() Dim a, ws As Worksheet, sh As Worksheet, i As Long Set ws = ThisWorkbook.Worksheets("Sheet1") Set sh = ThisWorkbook.Worksheets("Sheet2") With ws a = Array(Empty, .Range("C11").Value, .Range("C9").Value, .Range("C6").Value, .Range("C12").Value, .Range("C8").Value) End With With sh.ListObjects(1) For i = 1 To .ListRows.Count If Application.CountA(.ListRows(i).Range) = 0 Then Exit For Next i If i > .ListRows.Count Then .ListRows.Add .ListRows(i).Range.Value = a End With End Sub

السلام عليكم 🙂 جواب اخوي الدكتور حسين يأتي من رؤيته للاشكال في كل صورة ، وحسب رقم الصور 🙂 ولكن ، اذا اعدت تسمية المرفقات بأرقام او اسماء اخرى ، فهنا نحتاج الى طريقة ثابته لتأخذ جميع الاحتمالات ، اسماء اشكال وفواكه وبلدان وووووو ، فأحد الطرق ان يكون اسم الملف هو يشرح محتواه ، ولكن الطريقة الاصح هي ان تضيف معلومات اضافية في MetaData الصورة (البيانات الوصفية) عن طريق البيانات في EXIF الصورة ، في احد الحقول ، مثل tag ، ويمكنك رؤية وتغيير هذه البيانات عن طريق: متصفح الملفات ، ثم تنقر على ملف الصورة بالزر اليمين ، ثم تفاصيل ، ثم تفاصيل : . وهذه الاضافات يمكنك اضافتها في جميع انواع ملفات الصور (jpg , bmp , tiff ...) ، ماعدا صيغة png القديمة. وتستطيع استعمال كود لقراءة هذه البيانات ، مثل: https://docs.microsoft.com/en-us/previous-versions/tn-archive/ee176615(v=technet.10)?redirectedfrom=MSDN او https://www.devhut.net/get-image-exif-properties-using-vba-and-powershell/ جعفر

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

الشكر لله الذي وفقنا لهذا

استبدل الكود في حدث عند الفتح بالتالي On Error Resume Next If DCount("*", "UPDATES", "[Select]=False") <> 0 Then Call NewUPDATE Else Kill CurrentProject.Path & "\UpdateFile.cmd" End If

لابد من اضافة المكتبة Microsoft ActiveX Data Objects 2.5 Library ools > References > Check the checkbox in front of "Microsoft ActiveX Data Objects 2.5 Library" Other libraries that work include: Microsoft ActiveX Data Objects 2.6 Library Microsoft ActiveX Data Objects 2.7 Library Microsoft ActiveX Data Objects 2.8 Library Microsoft ActiveX Data Objects 6.1 Library

تفضل ....... ابا الحسن ... استيراد_ناقل.accdb

Sub Test() Dim a, ws As Worksheet, sh As Worksheet, m As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) Set sh = ThisWorkbook.Worksheets(2) a = ws.Range("B6:M" & ws.Cells(Rows.Count, "C").End(xlUp).Row).Value a = Application.Index(a, Evaluate("ROW(1:" & UBound(a, 1) & ")"), [{1,2,3,6,9,10,11,12}]) 'first empty row (new line added) m = sh.Cells(Rows.Count, 2).End(xlUp).Row + 1 'change 7 in the following two lines to use the variable m instead sh.Range("A" & m).Resize(UBound(a, 1), UBound(a, 2)).Value = a sh.Range("I" & m).Resize(UBound(a, 1)).Value = ws.Range("C4").Value Application.ScreenUpdating = True End Sub

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

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

أخى الحبيب وأستاذى / ياسر خليل اللهم تقبل اللهم آمين ، وسلمكم الله من كل سوء وجزيتم عنى خيرا

السلام عليكم أخي الحبيب محمود حمداً لله على سلامتك وأسأل الله العظيم رب العرش العظيم أن يشفيك لكم نفتقد تواجدك فيما بيننا ..سلمك الله من كل سوء ومن كل شر ، وفرج عنك كل كرب

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

السلام عليكم اخي الحبيب يحيى حسين ملك المعادلات بارك الله فيك ولاثراء الموضوع هنا حل اخر بالاكواد الرقم الناقص1.rar