اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

03 عضو مميز
  • Posts

    373
  • تاريخ الانضمام

  • تاريخ اخر زياره

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

  1. اخواني الاعزاء الكرماء واساتذتي الفضلاء عثرت علي قاعدة بيانات مفتوحة المصدر وبها كل شيئ تمام ولكن ينقصها شاشاتان مردود مشتريات ومردود مبيعات وبها نموذج وارد الخزنة لا يعمل القاعدة حجمها 19 ميجا هل اقوم بارفاقها كلها ام جزء معين منها
  2. تم الامر اخي بارك الله فيك اصبح كذلك SELECT tblExpenses.flatNo FROM tblExpenses GROUP BY tblExpenses.flatNo, IIf(Mid([flatNo],3,2)="00",1,0) HAVING (((tblExpenses.flatNo) Not Like "1308" And (tblExpenses.flatNo) Not Like "1307") AND ((IIf(Mid([flatNo],3,2)="00",1,0))<>1));
  3. مصدر الصف عندي هكذا SELECT tblExpenses.flatNo FROM tblExpenses GROUP BY tblExpenses.flatNo, IIf(Mid([flatNo],3,2)="00",1,0) HAVING (((tblExpenses.flatNo) Is Not Null) AND ((IIf(Mid([flatNo],3,2)="00",1,0))<>1)); يتم الغاء هذا كله ام نضيف اليه ما تفضلت به اخي واين نضيف الجملة الجديدة
  4. @دروب مبرمج اخي الفاضل في انتظار المرفق واخواني الاعزاء الافاضل الكرماء @ابوخليل @Moosak @kkhalifa1960 @محمد ايمن @Eng.Qassim @
  5. @Eng.Qassim كيف يتم اخفاء شقق معينة ( 1307) و (1308) في نموذج erad فقط ويظهروا في نموذج الارشيف في البيانات السابقة بمعني اخر لا اريد حذف السجل لان عليه حركة من 2006 والي الان واريد اخفاءه فقط واظهاره عند الحاجه
  6. احبابي الكرام واساتذتي الاعزاء اريد تحويل القاعدة الي نشاط اخر او منشأة اخري فكيف اقوم بتفريغ القاعدة من جميع البيانات في كل الجداول مره واحدة مع الاحتفاظ بالعلاقات الموجودة بين الجداول وبعضها البعض مجرد فكرة هل يتم الغاء جميع السجلات ما عدا السجل الاول في كل الجداول ويتم تعديله يدويا فيما بعد في المنشاءة الجديده او النشاط الجديد ام ماذا نصنع عقاري.rar
  7. @Eng.Qassim اخي الحبيب كيف يتم اخفاء شقق معينة ( 1307) و (1308) في نموذج erad فقط ويظهروا في نموذج الارشيف في البيانات السابقة بمعني اخر لا اريد حذف السجل لان عليه حركة واريد اخفاءه فقط عقاري.rar
  8. اخي الفاضل الكريم اشكر لك تقديم العون لي ولقد قمت باجراء ما تفضلت به ولكن بلا جدوي اخي لو امكن ارفاق ملف اكن لك من الشاكرين
  9. بارك الله فيك اخي الحبيب ابو خليل بارك الله فيك اخي الحبيب موسي
  10. احبابي واخواني بارك الله فيكم جميعا علي ما قدمتموه وما زلتم تقدموه لي ولباقي الاعضاء من وافر علمكم وخبراتكم كنت منذ زمن بعيد اتمني حماية قاعدة البيانات وتطرقت الي مواضيع كثيرة معكم لانواع الحماية وتقريبا فعلت معظمها وكان باقي تحويل القاعدة الي accde فالسؤال هنا هل اقوم بتحويلها علي القاعدة بعد تقسيمها ولو كان كذلك فيتم التحويل علي ملف النماذج ام علي ملف الجداول طيب وبعد تحويل القاعدة ما الفائدة من التقسيم حيث انني تاكدت من عدم مقدرة اي احد علي العبث بالقاعدة بعد تحويلها وماذا لو اراد العميل تعديلات ما في التقارير او شكل نموذج ما او الغاء حقل ما في نموذج او الغاء تقرير ما او ............................................ اظن مش محتاجين هنا لارفاق قاعدة بيانات
  11. اخواني الاعزاء الفضلاء واساتذتي الكرام الفكرة هي عند وجود اصناف جديدة يتم اضافتها في نموذج اضافة الاصناف (items)ومن ضمن الحقول حقل اخر سعر شراء اتمني ان يظهر هذا السعر في فاتورة الشراء (purchase_header)او فاتورة مردود المشتريات (purchase_header_credit_memo) ولكم مني وافر التحية والتقدير وطبعا الملف المرفق Database2.rar
  12. هههههه اضحك الله سنك اخي الحبيب هي بصراحة ممرتش بس قلت لعل وعسي طالما القاعدة مفتوحة وشايف اسماء النماذج يكون فيه امل ونفتح الاكواد بارك الله فيكم جميعا اساتذتي الكرام
  13. الاكواد المبرمجية غير متاحة هل هناك طريقة لفتحها
  14. اخي خليفة وضعت الكود السابق ولم يفلح فوضعت هذا الكود اخي 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 هل هذا صحيح
  15. اخي الحبيب خليفة ما فهمته بناءا علي ما قرأته وهو اذا رغبت في وضع الكود الموضوع تحت زر الامر " اعادة التحجيم " في حدث عند الفتح او التحميل فلا يوجد مشكله . نضع هذا الحدث في النموذج عند الفتح 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 هل فهمي لامر صحيح هكذا اخي
  16. مين قال ان حضرتك لم تتمكن من ايصال المعلومة تبارك الله لا قوة الا بالله شرح حضرتك وافي وكافي وبارك الله فيك اخي لقد فهمت الان ووصلت الفكرة
  17. اخواني الاعزاء الفضلاء واساتذتي الكرام لقد قمت بعمل تعديلات علي النماذج وتم وضعها في برنامج العميل فاشتكي ان النموذج لم يظهر بالكامل فهل هناك حل بكود يحل الامر اتوماتيكيا بدل التغيير في كل نموذج حتي يتلائم مع دقة شاشة العميل مثال علي نمذج erad الي حضراتكم المرفق عقاري.rar
×
×
  • اضف...

Important Information