.Azhar

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

رائع استاذ علي جميل جدا شكرا لمرورك استاذ ابا عمر وكل عام وانت بالف خير

السلام عليكم اقدم لكم مثال لكيفية عرض تقرير واحد في ثلاثة اشكال . من خلال عرض التقرير لكل الموظفين . عرض التقرير للموظف المعروض . عرض التقرير للموظفين الذين تبدأ اسمائهم بحرف معين , انا اخترت حرف (م) اترككم مع البرنامج وارجوا بالضغط على (اعجبني هذا ) على يسار الشاشة . تحياتي لكم . فرز التقرير.rar

مبدع استاذ علي . ربي يزيدك من العلم . تحياتي لك يا ورد

مساء الخير اولا نصيحة لاتستخدم الاسماء العربية لتسميات الجداول والاستعلامات والنماذج والتقارير . استخدم الحروف الانكليزية حتى ولو تسميها بالصوت العربي يعني مثلا . نموذج الموظفين : في الانكليزي Mudfen وهكذا لان اثناء دخولك لعالم VBA والدوال والتعابير سوف تعاني من مشاكل لا حدود لها . تفضل هذا هو التعديل . Data.rar

وهذه اكواد بلغة API لكل خاصية يمكنك ان تختار من يبقى ومن يحذف . Sub HideMaxMin() Dim lngStyle As Long lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE) lngStyle = lngStyle And Not WS_MINIMIZEBOX lngStyle = lngStyle And Not WS_MAXIMIZEBOX Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle) Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME) End Sub Sub ShowMinMax() Dim lngStyle As Long lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE) lngStyle = lngStyle Or WS_MINIMIZEBOX lngStyle = lngStyle Or WS_MAXIMIZEBOX Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle) Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME) End Sub Sub DisableMax() Dim lngStyle As Long lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE) lngStyle = lngStyle And Not WS_MAXIMIZEBOX Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle) Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME) End Sub Sub EnableMax() Dim lngStyle As Long lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE) lngStyle = lngStyle Or WS_MAXIMIZEBOX Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle) Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME) End Sub Sub DisableMin() Dim lngStyle As Long lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE) lngStyle = lngStyle And Not WS_MINIMIZEBOX Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle) Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME) End Sub Sub EnableMin() Dim lngStyle As Long lngStyle = GetWindowLong(hWndAccessApp, GWL_STYLE) lngStyle = lngStyle Or WS_MINIMIZEBOX Call SetWindowLong(hWndAccessApp, GWL_STYLE, lngStyle) Call SetWindowPos(hWndAccessApp, HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME) End Sub

وهذا الكود لاخفاء الاكسس وجعل واجهاتك فقط تظهر . لكن يعمل هذا الكود فقط على 2007 و 2010 Private Sub Form_Load() DoCmd.ShowToolbar "Ribbon", acToolbarNo DoCmd.ShowToolbar "Status Bar", acToolbarNo DoCmd.NavigateTo "acNavigationCategoryObjectType" DoCmd.RunCommand acCmdWindowHide End Sub

انظر لهذا المثال HedX.rar

تفضل انظر لهذا الموضوع http://www.officena.net/ib/index.php?showtopic=55712

هههههههه اهلا بك اخي هذا المثال لي , وتم شرحه بالتفصيل

ابو عبير هل جربت الوحدة النمطية ام لا هذه الداله لا تكبر ولا تصغر النافذه بل تلغي خاصية X ولا يمكن غلق البرنامج لا من النافذه ولا من الاكسس لان حتى علامة Xالخاصة ببرنامج الاكسس سوف تلغى , لذا يجب وضع زر خاص بك للخروج من البرنامج .

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

طيب لكن هذا الشي لا تستطيع فعله الا بداله او وحدة نمطية وهذه الوحدة النمطية سوف تزيل لك كل علامة الخروج في الاكسس نفسه وفي فرومات برنامجك . سوف ارفق لك الكود البرمجي للوحدة النمطية . Private Declare Function SetWindowLong Lib "user32" Alias _ "SetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long, _ ByVal dwnewlong As Long) As Long Private Declare Function GetWindowLong Lib "user32" Alias _ "GetWindowLongA" (ByVal hWnd As Long, ByVal nindex As Long) As Long Const WS_MINIMIZEBOX = &H20000 Const WS_MAXIMIZEBOX = &H10000 Const WS_CLOSEBOX = &H80000 Const GWL_STYLE = (-16) Sub RemoveMaxMinCloseBoxes() Dim M As Long Dim hWnd As Long hWnd = Application.hWndAccessApp M = GetWindowLong(hWnd, GWL_STYLE) M = M And Not (WS_MINIMIZEBOX) M = M And Not (WS_MAXIMIZEBOX) M = M And Not (WS_CLOSEBOX) M = SetWindowLong(hWnd, GWL_STYLE, M) End Sub Sub RestoreMaxMinCloseBoxes() Dim M As Long Dim hWnd As Long hWnd = Application.hWndAccessApp M = GetWindowLong(hWnd, GWL_STYLE) M = M Or (WS_MINIMIZEBOX) M = M Or (WS_MAXIMIZEBOX) M = M Or (WS_CLOSEBOX) M = SetWindowLong(hWnd, GWL_STYLE, M) End Sub استدعاء الدالة Private Sub Form_Load() RemoveMaxMinCloseBoxes End Sub

اجعل الاول نعم والاخر لا بمعنى الكونترول بوكس نعم سوف يظهر لديك X لكن لا يعمل

اخي العزيز ابو عبير ردا على كلامك : عند تصدير قاعدة البيانات إلى ACCDE حتى ولو بدون أكواد فهي لا تعمل . كيف بدون اكواد وما ادراك بدون اكواد , توجد في البرنامج ماكروات غير مضمنة وماكروات مضمنة وهذا يعتبر كود http://office.microsoft.com/ar-sa/access-help/HA001214202.aspx لكن اجعل الاوفيس في الجهازين 32 بت واترك النظام على حاله . الغاية من تحويل الاوفيس الى 64 هو لغرض استيعام قاعدة البيانات الى بيانات بحجم 2 كيكا . واكبر قاعدة بيانات لا تصل الى هذا الحجم . حيث توجد في جهازي قاعدة بيانات تحتوي على 14695 موظف وحجمها 48 ميكا شاهد الصور المرفقة . ههههههه فهل من المعقول توجد لديك قاعدة بيانات فيها اكثر من عدد الموظفين في هذا البرنامج . اعتقد نصب 32 بت هو افضل وقليل المشاكل وشركة ماكروسوفت تنصح به .

لاحظ الشرح في الصورة المرفقة

مرحبا اخي هل الحقول التي اشرت اليها ثابتة المدخلات =DCount("*";"Table";"(Field = '1' OR Field='2' OR Field='3' )")

اخي ابو عبير ماهي نسخة الوندوز عندك من هو 64 بت هل هو الوندوز ام الاوفيس . اذا كان نظام التشغيل وندوز 64 فان الاوفيس 32 يعمل بصورة طبيعية . ممكن ان توضح لي ما هي نسخة الوندوز وما هي نسخة الاوفيس ؟

اخي العزيز ضع الصورة مع البرنامج اينما تضعه

تحية لكم تفضل اخي ابو عبير هذا التعديل لكن عند فتح الضغط اجعل الصور مرفقه مع البرنامج في اي مكان يذهب . New folder (3).rar

وهذه نسخة 2003 بحث متعدد.rar

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

طيب على اي اساس انت تحسب مدة العمل ؟ لنفترض ان هذان الحقلان هما بداية التاريخ ونهاية التاريخ .... اوك . ضع في سجل ابراهيم بداية عمله من 1/9/2014 ولغاية 1/10/2014 افتح انشاء ... استعلام بالتصميم . لا تختار اي جدول ... اختر من زر التصميم في شريط المهام جملة SQL سوف تنفتح لك ورقة بيضاء فيها جمله صغيرة احذف هذه الجمله . انسخ هذا الكود والصقه في مكانها . ولاحظ من خلال هذا الاستعلام انشأ تقرير . انا كلامي واضح التقارير تستند اما للجداول مباشرة او استعلام . SELECT Pre_emp.Nom, Pre_emp.Prenom, Pre_emp.date_t, Pre_emp.fin_contra, DateDiff("d",[Pre_emp].[date_t],[Pre_emp].[fin_contra]) AS TotalSick FROM Pre_emp WHERE (((DateDiff("d",[Pre_emp].[date_t],[Pre_emp].[fin_contra]))>22));

هل date_t و fin_contra هو بداية التاريخ ونهاية التاريخ

استخدم هذا الكود لكن يجب اضافة جدول جديد اسمه tblHolidays فيه حقل اسمه HolidayDate هذا الحقل تحدد فيه ايام العطل لديك ليس فقط يوم الجمعة والسبت . بمعنى حتى المناسبات لبلدك . بعدها قم بانشاء استعلام ضع له معايير يعرض لك اكبر من 22 فقط 22< واستعلام اخر يعرض لك اصغر من 22 > حتى من خلالهم تعرض لك العمال الذين عملو اقل واكثر . Public Function WorkingDays2(StartDate As Date, EndDate As Date) As Integer ' Comment: Accepts two dates and returns the number of weekdays between them ' Note that this function has been modified to account for holidays. It requires a table ' named tblHolidays with a field named HolidayDate. '.................................................................... On Error GoTo Err_WorkingDays2 Dim intCount As Integer Dim rst As DAO.Recordset Dim DB As DAO.Database Set DB = CurrentDb Set rst = DB.OpenRecordset("SELECT [HolidayDate] FROM tblHolidays", dbOpenSnapshot) 'StartDate = StartDate + 1 'To count StartDate as the 1st day comment out the line above intCount = 0 Do While StartDate <= EndDate rst.FindFirst "[HolidayDate] = #" & StartDate & "#" If Weekday(StartDate) <> vbSunday And Weekday(StartDate) <> vbSaturday Then If rst.NoMatch Then intCount = intCount + 1 End If StartDate = StartDate + 1 Loop WorkingDays2 = intCount Exit_WorkingDays2: Exit Function Err_WorkingDays2: Select Case Err Case Else MsgBox Err.Description Resume Exit_WorkingDays2 End Select End Function