ابو عبد الرحمن اشرف

@Eng.Qassim اخي الحبيب كيف يتم اخفاء شقق معينة ( 1307) و (1308) في نموذج erad فقط ويظهروا في نموذج الارشيف في البيانات السابقة بمعني اخر لا اريد حذف السجل لان عليه حركة واريد اخفاءه فقط عقاري.rar

اخي الفاضل الكريم اشكر لك تقديم العون لي ولقد قمت باجراء ما تفضلت به ولكن بلا جدوي اخي لو امكن ارفاق ملف اكن لك من الشاكرين

بارك الله فيك اخي الحبيب ابو خليل بارك الله فيك اخي الحبيب موسي

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

اخواني الاعزاء الفضلاء واساتذتي الكرام الفكرة هي عند وجود اصناف جديدة يتم اضافتها في نموذج اضافة الاصناف (items)ومن ضمن الحقول حقل اخر سعر شراء اتمني ان يظهر هذا السعر في فاتورة الشراء (purchase_header)او فاتورة مردود المشتريات (purchase_header_credit_memo) ولكم مني وافر التحية والتقدير وطبعا الملف المرفق Database2.rar

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

ابشر اخي تفضل المرفق EASY_SALE.rar

الاكواد المبرمجية غير متاحة هل هناك طريقة لفتحها

اخي خليفة وضعت الكود السابق ولم يفلح فوضعت هذا الكود اخي Dim sngFactorP As Single On Error Resume Next If getScreenResolution.DPI <> 0 Then sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI Else sngFactorP = 1 End If If blnVert Then getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP Else getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP End If هل هذا صحيح

اخي الحبيب خليفة ما فهمته بناءا علي ما قرأته وهو اذا رغبت في وضع الكود الموضوع تحت زر الامر " اعادة التحجيم " في حدث عند الفتح او التحميل فلا يوجد مشكله . نضع هذا الحدث في النموذج عند الفتح On Error Resume Next ReSizeForm Me 'اعادة تحجيم النموذج الرئيسي ReSizeForm subForm.Form 'اعادة تحجيم النموذج الفرعي Me.cmdClose.SetFocus Me.cmdResize.Enabled = False ثم ننسخ الوحدة النمطية هذه الي قاعدة البيانات Option Compare Database Option Explicit 'قم بتغيير الارقام بناء على دقة الشاشة التي سوف تستخدمها للعرض مثلا 640 × 480 او 800 × 600 او 1024 × 768 بيكسل Private Const DESIGN_HORZRES As Long = 640 Private Const DESIGN_VERTRES As Long = 480 'مقدار عدد البكسلات في البوصة الواحده 96 يفضل تركه كما هو لانه قياسي Private Const DESIGN_PIXELS As Long = 96 Private Const WM_HORZRES As Long = 8 Private Const WM_VERTRES As Long = 10 Private Const WM_LOGPIXELSX As Long = 88 Private Const TITLEBAR_PIXELS As Long = 18 Private Const COMMANDBAR_PIXELS As Long = 26 Private Const COMMANDBAR_LEFT As Long = 0 Private Const COMMANDBAR_TOP As Long = 1 Private OrigWindow As tWindow Private Type tRect left As Long Top As Long right As Long bottom As Long End Type Private Type tDisplay Height As Long Width As Long DPI As Long End Type Private Type tWindow Height As Long Width As Long End Type Private Type tControl Name As String Height As Long Width As Long Top As Long left As Long End Type Private Declare Function WM_apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _ (ByVal hdc As Long, ByVal nIndex As Long) As Long Private Declare Function WM_apiGetDesktopWindow Lib "user32" Alias "GetDesktopWindow" _ () As Long Private Declare Function WM_apiGetDC Lib "user32" Alias "GetDC" _ (ByVal hwnd As Long) As Long Private Declare Function WM_apiReleaseDC Lib "user32" Alias "ReleaseDC" _ (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function WM_apiGetWindowRect Lib "user32.dll" Alias "GetWindowRect" _ (ByVal hwnd As Long, lpRect As tRect) As Long Private Declare Function WM_apiMoveWindow Lib "user32.dll" 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 Private Declare Function WM_apiIsZoomed Lib "user32.dll" Alias "IsZoomed" _ (ByVal hwnd As Long) As Long 'الغرض من هذه الوظيفة هو احضار معلومات الطول والعرض والبيكسل الحالي لشاشة العرض Private Function getScreenResolution() As tDisplay Dim hDCcaps As Long Dim lngRtn As Long On Error Resume Next hDCcaps = WM_apiGetDC(0) With getScreenResolution .Height = WM_apiGetDeviceCaps(hDCcaps, WM_VERTRES) .Width = WM_apiGetDeviceCaps(hDCcaps, WM_HORZRES) .DPI = WM_apiGetDeviceCaps(hDCcaps, WM_LOGPIXELSX) End With lngRtn = WM_apiReleaseDC(0, hDCcaps) End Function 'الغرض من هذه الوظيفة هو اعادة قيم عناصر النموذج كاملة في الطول والعرض وتكبيرها حسب مقاس الشاشة الحالية Private Function getFactor(blnVert As Boolean) As Single Dim sngFactorP As Single On Error Resume Next If getScreenResolution.DPI <> 0 Then sngFactorP = DESIGN_PIXELS / getScreenResolution.DPI Else sngFactorP = 1 End If If blnVert Then getFactor = (getScreenResolution.Height / DESIGN_VERTRES) * sngFactorP Else getFactor = (getScreenResolution.Width / DESIGN_HORZRES) * sngFactorP End If End Function 'الغرض من هذه الوظيفة هي القيام بإستدعاءها في حدث عند الفتح وعند التحميل Public Sub ReSizeForm(ByVal frm As Access.Form) Dim rectWindow As tRect Dim lngWidth As Long Dim lngHeight As Long Dim sngVertFactor As Single Dim sngHorzFactor As Single Dim sngFontFactor As Single On Error Resume Next sngVertFactor = getFactor(True) sngHorzFactor = getFactor(False) sngFontFactor = VBA.IIf(sngHorzFactor < sngVertFactor, sngHorzFactor, sngVertFactor) Resize sngVertFactor, sngHorzFactor, sngFontFactor, frm If WM_apiIsZoomed(frm.hwnd) = 0 Then Access.DoCmd.RunCommand acCmdAppMaximize Call WM_apiGetWindowRect(frm.hwnd, rectWindow) With rectWindow lngWidth = .right - .left lngHeight = .bottom - .Top End With If frm.Parent.Name = VBA.vbNullString Then Call WM_apiMoveWindow(frm.hwnd, ((getScreenResolution.Width - _ (sngHorzFactor * lngWidth)) / 2) - getLeftOffset, _ ((getScreenResolution.Height - (sngVertFactor * lngHeight)) / 2) - _ getTopOffset, lngWidth * sngHorzFactor, lngHeight * sngVertFactor, 1) End If End If Set frm = Nothing End Sub 'الغرض من هذه الوظيفة هي اعادة تحجيم مقاسات الاقسام الخاصة بالنموذج مثل قسم تفصيل وقسم رأس النموذج وتذييل النموذج Private Sub Resize(sngVertFactor As Single, sngHorzFactor As Single, sngFontFactor As _ Single, ByVal frm As Access.Form) Dim ctl As Access.Control Dim arrCtls() As tControl Dim lngI As Long Dim lngJ As Long Dim lngWidth As Long Dim lngHeaderHeight As Long Dim lngDetailHeight As Long Dim lngFooterHeight As Long Dim blnHeaderVisible As Boolean Dim blnDetailVisible As Boolean Dim blnFooterVisible As Boolean Const FORM_MAX As Long = 31680 On Error Resume Next With frm .Painting = False lngWidth = .Width * sngHorzFactor lngHeaderHeight = .Section(Access.acHeader).Height * sngVertFactor lngDetailHeight = .Section(Access.acDetail).Height * sngVertFactor lngFooterHeight = .Section(Access.acFooter).Height * sngVertFactor .Width = FORM_MAX .Section(Access.acHeader).Height = FORM_MAX .Section(Access.acDetail).Height = FORM_MAX .Section(Access.acFooter).Height = FORM_MAX blnHeaderVisible = .Section(Access.acHeader).Visible blnDetailVisible = .Section(Access.acDetail).Visible blnFooterVisible = .Section(Access.acFooter).Visible .Section(Access.acHeader).Visible = False .Section(Access.acDetail).Visible = False .Section(Access.acFooter).Visible = False End With ReDim arrCtls(0) For Each ctl In frm.Controls If ((ctl.ControlType = Access.acTabCtl) Or _ (ctl.ControlType = Access.acOptionGroup)) Then With arrCtls(lngI) .Name = ctl.Name .Height = ctl.Height .Width = ctl.Width .Top = ctl.Top .left = ctl.left End With lngI = lngI + 1 ReDim Preserve arrCtls(lngI) End If Next ctl For Each ctl In frm.Controls If ctl.ControlType <> Access.acPage Then With ctl .Height = .Height * sngVertFactor .left = .left * sngHorzFactor .Top = .Top * sngVertFactor .Width = .Width * sngHorzFactor .FontSize = .FontSize * sngFontFactor Select Case .ControlType Case Access.acListBox .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor) Case Access.acComboBox .ColumnWidths = adjustColumnWidths(.ColumnWidths, sngHorzFactor) .ListWidth = .ListWidth * sngHorzFactor Case Access.acTabCtl .TabFixedWidth = .TabFixedWidth * sngHorzFactor .TabFixedHeight = .TabFixedHeight * sngVertFactor End Select End With End If Next ctl For lngJ = 0 To lngI With frm.Controls.Item(arrCtls(lngJ).Name) .left = arrCtls(lngJ).left * sngHorzFactor .Top = arrCtls(lngJ).Top * sngVertFactor .Height = arrCtls(lngJ).Height * sngVertFactor .Width = arrCtls(lngJ).Width * sngHorzFactor End With Next lngJ With frm .Width = lngWidth .Section(Access.acHeader).Height = lngHeaderHeight .Section(Access.acDetail).Height = lngDetailHeight .Section(Access.acFooter).Height = lngFooterHeight .Section(Access.acHeader).Visible = blnHeaderVisible .Section(Access.acDetail).Visible = blnDetailVisible .Section(Access.acFooter).Visible = blnFooterVisible .Painting = True End With Erase arrCtls Set ctl = Nothing End Sub 'الغرض من هذه الوظيفة هو حساب مجموع البيكسل لكامل شاشة الاكسيس ناحية اليمين ووضع النموذج في منتصف الشاشة Private Function getTopOffset() As Long Dim cmdBar As Object Dim lngI As Long On Error GoTo err For Each cmdBar In Application.CommandBars If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_TOP)) Then lngI = lngI + 1 End If Next cmdBar getTopOffset = (TITLEBAR_PIXELS + (lngI * COMMANDBAR_PIXELS)) exit_fun: Exit Function err: getTopOffset = TITLEBAR_PIXELS + COMMANDBAR_PIXELS Resume exit_fun End Function 'الغرض من هذه الوظيفة هو حساب مجموع البيكسل لكامل شاشة الاكسيس ناحية اليسار ووضع النموذج في منتصف الشاشة Private Function getLeftOffset() As Long Dim cmdBar As Object Dim lngI As Long On Error GoTo err For Each cmdBar In Application.CommandBars If ((cmdBar.Visible = True) And (cmdBar.Position = COMMANDBAR_LEFT)) Then lngI = lngI + 1 End If Next cmdBar getLeftOffset = (lngI * COMMANDBAR_PIXELS) exit_fun: Exit Function err: getLeftOffset = 0 Resume exit_fun End Function 'الغرض من هذه الوظيفة هو اعادة تحجيم كامل عرض الاعمدة وعدم ترك فراغات من الناحية اليسرى Private Function adjustColumnWidths(strColumnWidths As String, sngFactor As Single) As String On Error GoTo Err_adjustColumnWidths Dim astrColumnWidths() As String Dim strTemp As String Dim lngI As Long Dim lngJ As Long ReDim astrColumnWidths(0) For lngI = 1 To VBA.Len(strColumnWidths) Select Case VBA.Mid(strColumnWidths, lngI, 1) Case Is <> ";" astrColumnWidths(lngJ) = astrColumnWidths(lngJ) & VBA.Mid( _ strColumnWidths, lngI, 1) Case ";" lngJ = lngJ + 1 ReDim Preserve astrColumnWidths(lngJ) End Select Next lngI lngI = 0 strTemp = VBA.vbNullString Do Until lngI > UBound(astrColumnWidths) If Not IsNull(astrColumnWidths(lngI)) And astrColumnWidths(lngI) <> "" Then strTemp = strTemp & CSng(astrColumnWidths(lngI)) * sngFactor & ";" End If lngI = lngI + 1 Loop adjustColumnWidths = strTemp Erase astrColumnWidths Exit_adjustColumnWidths: On Error Resume Next Exit Function Err_adjustColumnWidths: Erase astrColumnWidths 'Destroy array. Resume Exit_adjustColumnWidths End Function 'الغرض من هذه الوظيفة اعادة حجم النموذج الى وضعه الطبيعي قبل اعادة التحجيم ويتم استدعاؤها عن تحميل النموذج Public Sub getOrigWindow(frm As Access.Form) On Error Resume Next OrigWindow.Height = frm.WindowHeight OrigWindow.Width = frm.WindowWidth End Sub 'الغرض من هذه الوظيفة هو اعادة مقاس النموذج الى وضعه الطبيعي عند حدث الاغلاق Public Sub RestoreWindow() On Error Resume Next Access.DoCmd.MoveSize , , OrigWindow.Width, OrigWindow.Height Access.DoCmd.Save End Sub هل فهمي لامر صحيح هكذا اخي

مين قال ان حضرتك لم تتمكن من ايصال المعلومة تبارك الله لا قوة الا بالله شرح حضرتك وافي وكافي وبارك الله فيك اخي لقد فهمت الان ووصلت الفكرة

اخواني الاعزاء الفضلاء واساتذتي الكرام لقد قمت بعمل تعديلات علي النماذج وتم وضعها في برنامج العميل فاشتكي ان النموذج لم يظهر بالكامل فهل هناك حل بكود يحل الامر اتوماتيكيا بدل التغيير في كل نموذج حتي يتلائم مع دقة شاشة العميل مثال علي نمذج erad الي حضراتكم المرفق عقاري.rar

بارك الله فيك اخي الحبيب تم الامر فجزاك الله خيرا علي السمكة ولكن انا اريد ان تعلمني الصيد اخي النموذج تم عمل حدث في الحالي Me.tblExpenses_e.Form.AllowEdits = False فما معني ذلك و مربع التحرير والسرد المسمي cbof تم عمل حدث بعد التحديث '[Forms]![eradat]![tblExpenses_e].Form.Filter = "[flatNo] = '" & Me.cboF & "'" '[Forms]![eradat]![tblExpenses_e].Form.FilterOn = True If Len(Me.cboF & vbNullString) > 0 Then [Forms]![eradat]![tblExpenses_e].Form.Filter = "[flatNo] = '" & Me.cboF & "'" [Forms]![eradat]![tblExpenses_e].Form.FilterOn = True Else [Forms]![eradat]![tblExpenses_e].Form.FilterOn = False End If فممكن شرح مبسط لذلك اخي الحبيب وحضرتك وعدتني بشرح مبسط اخر للدالة IIf(Mid([flatNo];3;2)="00";1;0) مع كتابة <>1 في المعيار اسف ان كنت اثقل عليك اخي

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

عشان كدة مش عايز يقبل خالص مشكور اخي الفاضل

اعتذر لك اخي عندك حق اليك اخي المرفق الصحيح عقاري.rar اعتذر استاذي القدير الخطأ من عندي عملت تقسيم لقاعدة البيانات ارفقت الملف الصحيح اخي الحبيب

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

اخواني الاحباب اعلم انكم جميعا مشغولون فبارك الله فيكم يا من تمدون يد العون لاخوانكم @Eng.Qassim

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

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

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

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

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

اخواني الاحباء الموضوع بانتظار ابدعاتكم @Moosak @kkhalifa1960 @Eng.Qassim @محمد ايمن

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