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

كل الانشطه

هذه الصفحة تحدث تلقائياً

  1. الساعة الأخيرة
  2. فهمت , كلامك صح , أسأل الله العظيم رب العرش العظيم أن يبارك لك في علمك , ويرزقك صحبة النبي في جنات النعيم .... بس ممكن حضرتك ترشح لي أسم برنامج ( الذكاء الأصطناعي ) اللي ممكن يساعدني في السؤال ,باللع عليك ما تضايقشي مني أنا بحاول أتعلم وأطور نفسي من خلال الجروب المحترم والناس المحترمين اللي زي حضرتك
  3. تم إضافة حقل للإجازات المرضية في الجدول كان قد سقط سهوا. تم تحديث أيام الحضور والغياب. لا أعرف لماذا هذه المرة تفكيري كله في الأكواد ولم أفكر في الاستعلامات. ما عندي شيء آخر آخر أضيفه. Attendance_08.rar
  4. تفضل أخي الكريم 3 ملفات الأول إذا كان الأوفيس عندك 365 أو 2016 فيما فوق الثاني إذا كان الأوفيس إصدار أقل من 2016 الثالث باستخدام الأكواد لا تنسى اختيار "اختر تمت الاجابة" إذا تم حل المشكلة استخراج_فواتير_بدون_تكرار (365).xlsx استخراج_فواتير_بدون_تكرار (أوفيس قديم).xlsx استخراج_فواتير_بدون_تكرار (كود).xlsm
  5. Today
  6. مبارك الأخ الكريم @Foksh بالتوفيق والنجاح دايما ان شاء الله. ونشكركم على هذا المنتدى الطيب المبارك وجزاكم الله خيرا
  7. المطلوب اخى الحبيب أن يتم ترحيل ارقام الفواتير من الورقه الاولى الى الورقه الثانية مع مراعاة عدم تكرار ارقام الفواتير على سبيل المثال فى الشيت الاول يظهر ان مكتب العريش له ارقام فواتير كالتالى 1410 1410 1412 1412 1412 1412 1412 1515 1515 1515 1515 1516 فالمطوب هو عند اختيار مكتب العريش فى الورقه الثانيه ان يظهر ارقام الفواتير الخاصه به بدون تكرار كالتالى 1410 1412 1515 1516
  8. اريد دورة اكسس متقدم حيث اني اقوم بعمل بعض البرامج ولكن تتوقف معي بعض النقاط فاريد استكمال هذه النواقص واريد ترشيحكم لافضل دورة علي يوتيوب او اي مكان وجزاكم الله خيرا
  9. هذه محاولة غير مكتملة فهي فقط تحدد العطل الأسبوعية والإجازات حتى الأن الباقي في حال راقت لكم الفكرة. صار لي فترة طويلة بعيد عن "شغلات" الاستعلامات وأفكار حلول شؤون الموظفين. نسيت أوضح أن الحل في الكود، والنتيجة ستكون في جدول tblEmpAttendance
  10. استدراك : المخرجات .. تقرير يعرض الأيام ( من تاريخ/ الى تاريخ ) .. سواء كان العرض لموظف واحد خلال فترة محددة او يعرض حالة يوم واحد لجميع الموظفين ................................ اخواني الكرام المهم هنا هي الفكرة او طريقة التنفيذ .. عرض الفكرة ومناقشتها هي حقيقة البرمجة .. اما التطبيق او التنفيذ فتتفقون معي انه مقدور عليه ان شاء الله ..
  11. Yesterday
  12. السلام عليكم ورحمه الله من فضلكم هل من الممكن ان استخرج تقرير في اكسس مثل الصورة المرفقه يكون فيه الرقم والتاريخ مدمجان واحدهما اسفل الاخر كما في الصوره والمثال المرفق مجلد جديد (3).rar
  13. السلام عليكم الاخوة الافاضل في هذا المنتدى الجميل في هذا الموضوع اريد معرفة ترتيب كل طالب من مجموع الطلاب (بما في ذلك عند القيام بعملية الفلترة يعطيني الترتيب وكذا مجموع الطلاب) من النموذج frm_examen_fin_formation اختار: السنة ثم الدرجة ثم البلد ثم افتح النموذج frm_modul في النموذج frm_modul : يعرض أسماء الطلبة حسب ما تم اختياره من النموذج السابق في هذا النموذج frm_modul أريد أن أعرف (الترتيب) الخاص بكل طالب من مجموع الطلاب وقد أضفت مربعي نص هما: ترتيب الطالب و مجموع الطلاب مثال فقط: من النموذج frm_examen_fin_formation اختار: السنة: 2022/2021 الدرجة: مساعد مهندس البلد: عمان ثم افتح النموذج frm_modul نلاحظ وجود 8 طلاب ما أريده من فضلكم هو أن أضع في مربعي النص الموجودين في النموذج : ترتيب كل طلاب : .... (الترتيب حسب المعدل العام من الأكبر إلى الأصغر وفي حالة التساوي في المعدل العام نضيف معيار آخر هو حقل ID من جدول info_stagiere ويكون من الأصغر إلى الأكبر ) مجموع الطلاب: هو تلقائا 8 حسب ما تم اختياره من النموذج السابق وهذا الكود يجب أن يشتغل مع عملية الفلترة و انهاء الفلترة (الأكواد موجودة للفلترة وانهاء الفلترة) يعني يعطيني في حالة البحث عن طالب يعطيني ترتيب هذا طالب وكذا مجموع الطلاب أنا حاولت محاولة ضعيفة اشتغلت معي لكن في عملية الفلترة وانهاء الفلترة لا يعطيني ترتيب كل طالب * حاجة ثانية من فضلكم أريد ان اعرف العلاقة صحيحة الموجودة بين الجدولين info_stagiere و modul بين الحقلين ID و id لاني استعملتها كثيرا في جداول مختلفة الرجاء المساعدة والتوجيه وبارك الله فيكم baseC.accdb
  14. فى انتظار المرفق ان شاء الله بعد انتهائك من تجميع الافكار وفق فكرتك العبقرية
  15. شكرا لاخي @ابو جودي سبقني بالحل الناجع ............................. ولكني حاولت تجميع فكرة في تصميم برنامج خاص بتعديل خصائص العناصر ::: مميزاته::::: - ممكن استخدامه للقاعدة الحالية أو قاعدة خارجية - اختيار الشكل المناسب من بين مجموعة اشكال ممكن يحتفظ بها المصمم لبرامج اخرى - اختيار نموذج من القاعدة الحالية او نموذج القاعدة الخارجية لمعاينة الشكل ( طبعا المعاينة لا تغير من خصائص عناصر النموذج ولكن للمشاهدة فقط) - يمكن تعديل الشكل ومعاينة النموذج المختار - بعد اختيار الشكل المناسب يتم الضغط عل تطبيق فيتم تطبيق الشكل على كامل النماذج في القاعدة ( سواءا الحالية _ او الخارخية ) - للاسف لم يسعفني الوقت لاكمال التصميم بسبب انشغالي هذه الفترة
  16. تحية طيبة أخي التسمية اخي يجب أن تكون عبارة عن نــــص ، لانها تصف الوثائق التي اريد أن اضيفها، ولأني كذلك سجلت بيانات عبارة أن تسميات عندي مدة طويلة و انا استعمل هذا الكود ان شاء الله عندما تطالع الملف يكون عندك الحل المناسب
  17. أخي الكريم وعليكم السلام ورحمة الله وبركاته 🤗 وبما أن المشروع ليس من تأسيسك ، فأعتقد انك بحاجة الى إعادة بناء المشروع ، وليس كما تظن 3 طلبات فقط. لذا .. أنصحك بالتوجه الى عرض طلباتك واحداً واحداً في مواضيع مستقلة ، مع الشرح الكافي مصحوباً بملف يحتوي سجلات بسيطة . ملاحظة:- لم أطلع على الملف .
  18. ادامك الله فوق رؤسنا وحفظكم لنا ولأحبابكم الحمد لله الذى تتم بنعمته الصالحات
  19. وعليكم السلام ورحمة الله وبركاته 🤗 باعتقادي ، وبما أنك تجعل اسم الوثيقة هو رقم ، فهنا يجب أن تجعل اسم الوثيقة مربوطاً أيضاً برقم الموظف ( الأفضل ) ، أو اسم الموظف على سبيل المثال . هنا الوثيقة 1 للموظف1 ستختلف في الاسم عن الوثيقة 1 للموظف2 ، صحيح 😁 . لم أطلع على الملف ، أتابع من الهاتف حالياً.
  20. نعم .. نعم .. هو كذا يا باشمهندس كذا الشغل والا بلاش .. سلمت أناملك .. وفكرك
  21. ليس بغريب عليك جراح اكسس فعلا وعملاق في افكارك الله ينور عليك يا دك
  22. حبيبي يا بروف انت ربنا يعلم من الأشخاص اللي اعتز بيهم انا بخير ماشي الحال اللي قولته دا فعلا من قلبي وقليل عليك انت تستاهل كل خير لانك فعلا انسان
  23. أهلاً يا فنان .. وحشتني يا راجل ، طمني عنك عامل إيه 🤗 .. الله يبارك فيك على كلامك اللطيف الجميل 😇😇
  24. اعتقد أن اللقب الجديد مش هيضيف للبروف شئ جديد لأنه من يزين الألقاب مجدا الف الف مبروك يا بروف دائما موفق
  25. السلام عليكم استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @ابوخليل ممتاز الان اتضحت لى الفكرة تمام انا كانت فكرتى ان لا اقوم بتعديل الاعدادت داخل كافة النماذج ولكن فقط تطبيق الاعدادت الجديدة مع الاحتفاظ بالوضع الاصلى عند التصميم ولكن حضرتك تريد فتح كافة النماذج فى وضع التصميم وتطبيق كل التعديلات على كافة النماذج لخدمة المصمم وطامل انها لخدمة المصمم فقط وتريد كل الاكواد فى النموذج دون الاعتماد على وحدات نمطية ليسهل استخدام النموذج وما بجعبته مع اى قاعدة أخرى بمجرد نسخه اليها لقد قمت بكتابة الكود بالشكل التالى : Option Compare Database Option Explicit '' ======= التصريحات والثوابت #If VBA7 Then Private Declare PtrSafe Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long #Else Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long #End If #If VBA7 Then Private Type CHOOSECOLOR lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr rgbResult As Long lpCustColors As LongPtr Flags As Long lCustData As LongPtr lpfnHook As LongPtr lpTemplateName As LongPtr End Type #Else Private Type CHOOSECOLOR lStructSize As Long hwndOwner As Long hInstance As Long rgbResult As Long lpCustColors As Long Flags As Long lCustData As Long lpfnHook As Long lpTemplateName As Long End Type #End If Private Enum SectionType stHeader = acHeader stDetail = acDetail stFooter = acFooter End Enum Private Enum ControlType ctTextBox = acTextBox ctComboBox = acComboBox ctListBox = acListBox ctLabel = acLabel ctCommandButton = acCommandButton End Enum Private Const COLOR_UNSET As Long = -1 Private Const TABLE_NAME_THEME_SETTINGS As String = "tblThemeSettings" Private Const FIELD_NAME As String = "SettingName" Private Const FIELD_VALUE As String = "SettingValue" Private Theme As Object Private DebugMode As Boolean '' ======= إنشاء القاموس عند بدء التشغيل Private Sub InitializeThemeDictionary() Set Theme = CreateObject("Scripting.Dictionary") Theme.Add "Header", CreateObject("Scripting.Dictionary") Theme("Header").Add "SectionBack", COLOR_UNSET Theme("Header").Add "TextBack", COLOR_UNSET Theme("Header").Add "TextBorder", COLOR_UNSET Theme("Header").Add "TextFont", COLOR_UNSET Theme("Header").Add "LabelBack", COLOR_UNSET Theme("Header").Add "LabelBorder", COLOR_UNSET Theme("Header").Add "LabelFont", COLOR_UNSET Theme.Add "Detail", CreateObject("Scripting.Dictionary") Theme("Detail").Add "SectionBack", COLOR_UNSET Theme("Detail").Add "TextBack", COLOR_UNSET Theme("Detail").Add "TextBorder", COLOR_UNSET Theme("Detail").Add "TextFont", COLOR_UNSET Theme("Detail").Add "LabelBack", COLOR_UNSET Theme("Detail").Add "LabelBorder", COLOR_UNSET Theme("Detail").Add "LabelFont", COLOR_UNSET Theme.Add "Footer", CreateObject("Scripting.Dictionary") Theme("Footer").Add "SectionBack", COLOR_UNSET Theme("Footer").Add "TextBack", COLOR_UNSET Theme("Footer").Add "TextBorder", COLOR_UNSET Theme("Footer").Add "TextFont", COLOR_UNSET Theme("Footer").Add "LabelBack", COLOR_UNSET Theme("Footer").Add "LabelBorder", COLOR_UNSET Theme("Footer").Add "LabelFont", COLOR_UNSET Theme.Add "Button", CreateObject("Scripting.Dictionary") Theme("Button").Add "Back", COLOR_UNSET Theme("Button").Add "Border", COLOR_UNSET Theme("Button").Add "Font", COLOR_UNSET Theme("Button").Add "Hover", COLOR_UNSET Theme("Button").Add "Pressed", COLOR_UNSET Theme("Button").Add "HoverFore", COLOR_UNSET Theme("Button").Add "PressedFore", COLOR_UNSET Theme.Add "Combo", CreateObject("Scripting.Dictionary") Theme("Combo").Add "Back", COLOR_UNSET Theme("Combo").Add "Border", COLOR_UNSET Theme("Combo").Add "Font", COLOR_UNSET Theme.Add "List", CreateObject("Scripting.Dictionary") Theme("List").Add "Back", COLOR_UNSET Theme("List").Add "Border", COLOR_UNSET Theme("List").Add "Font", COLOR_UNSET End Sub '' ======= أحداث النموذج Private Sub Form_Load() InitializeThemeDictionary EnsureThemeTableExists LoadThemeFromTable End Sub Private Sub btnSaveAndApply_Click() SaveThemeToTable ApplyThemeToAllForms MsgBox "تم تطبيق الثيم بنجاح.", vbInformation End Sub Private Sub btnApplyDefaultThemeToCurrentForm_Click() SetDefaultThemeValues ApplyThemePreview End Sub '' ======= أزرار تغيير الألوان Private Sub btnHeaderSectionColor_Click() Dim lngColor As Long lngColor = Theme("Header")("SectionBack") ApplySectionColor lngColor, stHeader Theme("Header")("SectionBack") = lngColor ApplyThemePreview End Sub Private Sub btnHeaderControlBack_Click() Dim lngColor As Long lngColor = Theme("Header")("TextBack") HandleColorPick lngColor, "BackColor", ctTextBox, stHeader Theme("Header")("TextBack") = lngColor ApplyThemePreview End Sub Private Sub btnHeaderControlBorder_Click() Dim lngColor As Long lngColor = Theme("Header")("TextBorder") HandleColorPick lngColor, "BorderColor", ctTextBox, stHeader Theme("Header")("TextBorder") = lngColor ApplyThemePreview End Sub Private Sub btnHeaderControlFore_Click() Dim lngColor As Long lngColor = Theme("Header")("TextFont") HandleColorPick lngColor, "ForeColor", ctTextBox, stHeader Theme("Header")("TextFont") = lngColor ApplyThemePreview End Sub Private Sub btnHeaderLabelBack_Click() Dim lngColor As Long lngColor = Theme("Header")("LabelBack") HandleColorPick lngColor, "BackColor", ctLabel, stHeader Theme("Header")("LabelBack") = lngColor ApplyThemePreview End Sub Private Sub btnHeaderLabelBorder_Click() Dim lngColor As Long lngColor = Theme("Header")("LabelBorder") HandleColorPick lngColor, "BorderColor", ctLabel, stHeader Theme("Header")("LabelBorder") = lngColor ApplyThemePreview End Sub Private Sub btnHeaderLabelFore_Click() Dim lngColor As Long lngColor = Theme("Header")("LabelFont") HandleColorPick lngColor, "ForeColor", ctLabel, stHeader Theme("Header")("LabelFont") = lngColor ApplyThemePreview End Sub Private Sub btnDetailSectionColor_Click() Dim lngColor As Long lngColor = Theme("Detail")("SectionBack") ApplySectionColor lngColor, stDetail Theme("Detail")("SectionBack") = lngColor ApplyThemePreview End Sub Private Sub btnDetailControlBack_Click() Dim lngColor As Long lngColor = Theme("Detail")("TextBack") HandleColorPick lngColor, "BackColor", ctTextBox, stDetail Theme("Detail")("TextBack") = lngColor ApplyThemePreview End Sub Private Sub btnDetailControlBorder_Click() Dim lngColor As Long lngColor = Theme("Detail")("TextBorder") HandleColorPick lngColor, "BorderColor", ctTextBox, stDetail Theme("Detail")("TextBorder") = lngColor ApplyThemePreview End Sub Private Sub btnDetailControlFore_Click() Dim lngColor As Long lngColor = Theme("Detail")("TextFont") HandleColorPick lngColor, "ForeColor", ctTextBox, stDetail Theme("Detail")("TextFont") = lngColor ApplyThemePreview End Sub Private Sub btnDetailLabelBack_Click() Dim lngColor As Long lngColor = Theme("Detail")("LabelBack") HandleColorPick lngColor, "BackColor", ctLabel, stDetail Theme("Detail")("LabelBack") = lngColor ApplyThemePreview End Sub Private Sub btnDetailLabelBorder_Click() Dim lngColor As Long lngColor = Theme("Detail")("LabelBorder") HandleColorPick lngColor, "BorderColor", ctLabel, stDetail Theme("Detail")("LabelBorder") = lngColor ApplyThemePreview End Sub Private Sub btnDetailLabelFore_Click() Dim lngColor As Long lngColor = Theme("Detail")("LabelFont") HandleColorPick lngColor, "ForeColor", ctLabel, stDetail Theme("Detail")("LabelFont") = lngColor ApplyThemePreview End Sub Private Sub btnFooterSectionColor_Click() Dim lngColor As Long lngColor = Theme("Footer")("SectionBack") ApplySectionColor lngColor, stFooter Theme("Footer")("SectionBack") = lngColor ApplyThemePreview End Sub Private Sub btnFooterControlBack_Click() Dim lngColor As Long lngColor = Theme("Footer")("TextBack") HandleColorPick lngColor, "BackColor", ctTextBox, stFooter Theme("Footer")("TextBack") = lngColor ApplyThemePreview End Sub Private Sub btnFooterControlBorder_Click() Dim lngColor As Long lngColor = Theme("Footer")("TextBorder") HandleColorPick lngColor, "BorderColor", ctTextBox, stFooter Theme("Footer")("TextBorder") = lngColor ApplyThemePreview End Sub Private Sub btnFooterControlFore_Click() Dim lngColor As Long lngColor = Theme("Footer")("TextFont") HandleColorPick lngColor, "ForeColor", ctTextBox, stFooter Theme("Footer")("TextFont") = lngColor ApplyThemePreview End Sub Private Sub btnFooterLabelBack_Click() Dim lngColor As Long lngColor = Theme("Footer")("LabelBack") HandleColorPick lngColor, "BackColor", ctLabel, stFooter Theme("Footer")("LabelBack") = lngColor ApplyThemePreview End Sub Private Sub btnFooterLabelBorder_Click() Dim lngColor As Long lngColor = Theme("Footer")("LabelBorder") HandleColorPick lngColor, "BorderColor", ctLabel, stFooter Theme("Footer")("LabelBorder") = lngColor ApplyThemePreview End Sub Private Sub btnFooterLabelFore_Click() Dim lngColor As Long lngColor = Theme("Footer")("LabelFont") HandleColorPick lngColor, "ForeColor", ctLabel, stFooter Theme("Footer")("LabelFont") = lngColor ApplyThemePreview End Sub Private Sub btnCommandBack_Click() Dim lngColor As Long lngColor = Theme("Button")("Back") HandleColorPick lngColor, "BackColor", ctCommandButton Theme("Button")("Back") = lngColor ApplyThemePreview End Sub Private Sub btnCommandBorder_Click() Dim lngColor As Long lngColor = Theme("Button")("Border") HandleColorPick lngColor, "BorderColor", ctCommandButton Theme("Button")("Border") = lngColor ApplyThemePreview End Sub Private Sub btnCommandFore_Click() Dim lngColor As Long lngColor = Theme("Button")("Font") HandleColorPick lngColor, "ForeColor", ctCommandButton Theme("Button")("Font") = lngColor ApplyThemePreview End Sub Private Sub btnCommandHover_Click() Dim lngColor As Long lngColor = Theme("Button")("Hover") lngColor = PickColorFromBase(lngColor) Theme("Button")("Hover") = lngColor ApplyThemePreview End Sub Private Sub btnCommandPressed_Click() Dim lngColor As Long lngColor = Theme("Button")("Pressed") lngColor = PickColorFromBase(lngColor) Theme("Button")("Pressed") = lngColor ApplyThemePreview End Sub Private Sub btnCommandHoverFore_Click() Dim lngColor As Long lngColor = Theme("Button")("HoverFore") lngColor = PickColorFromBase(lngColor) Theme("Button")("HoverFore") = lngColor ApplyThemePreview End Sub Private Sub btnCommandPressedFore_Click() Dim lngColor As Long lngColor = Theme("Button")("PressedFore") lngColor = PickColorFromBase(lngColor) Theme("Button")("PressedFore") = lngColor ApplyThemePreview End Sub Private Sub btnComboBack_Click() Dim lngColor As Long lngColor = Theme("Combo")("Back") HandleColorPick lngColor, "BackColor", ctComboBox Theme("Combo")("Back") = lngColor ApplyThemePreview End Sub Private Sub btnComboBorder_Click() Dim lngColor As Long lngColor = Theme("Combo")("Border") HandleColorPick lngColor, "BorderColor", ctComboBox Theme("Combo")("Border") = lngColor ApplyThemePreview End Sub Private Sub btnComboFore_Click() Dim lngColor As Long lngColor = Theme("Combo")("Font") HandleColorPick lngColor, "ForeColor", ctComboBox Theme("Combo")("Font") = lngColor ApplyThemePreview End Sub Private Sub btnListBack_Click() Dim lngColor As Long lngColor = Theme("List")("Back") HandleColorPick lngColor, "BackColor", ctListBox Theme("List")("Back") = lngColor ApplyThemePreview End Sub Private Sub btnListBorder_Click() Dim lngColor As Long lngColor = Theme("List")("Border") HandleColorPick lngColor, "BorderColor", ctListBox Theme("List")("Border") = lngColor ApplyThemePreview End Sub Private Sub btnListFore_Click() Dim lngColor As Long lngColor = Theme("List")("Font") HandleColorPick lngColor, "ForeColor", ctListBox Theme("List")("Font") = lngColor ApplyThemePreview End Sub '' ======= قيم افتراضية Private Sub SetDefaultThemeValues() Theme("Header")("SectionBack") = RGB(230, 230, 250) Theme("Header")("TextBack") = RGB(255, 255, 255) Theme("Header")("TextBorder") = RGB(180, 180, 180) Theme("Header")("TextFont") = RGB(0, 0, 0) Theme("Header")("LabelBack") = RGB(240, 240, 240) Theme("Header")("LabelBorder") = RGB(240, 240, 240) Theme("Header")("LabelFont") = RGB(0, 0, 0) Theme("Detail")("SectionBack") = RGB(255, 255, 255) Theme("Detail")("TextBack") = RGB(255, 255, 255) Theme("Detail")("TextBorder") = RGB(180, 180, 180) Theme("Detail")("TextFont") = RGB(0, 0, 0) Theme("Detail")("LabelBack") = RGB(240, 240, 240) Theme("Detail")("LabelBorder") = RGB(240, 240, 240) Theme("Detail")("LabelFont") = RGB(0, 0, 0) Theme("Footer")("SectionBack") = RGB(245, 245, 245) Theme("Footer")("TextBack") = RGB(255, 255, 255) Theme("Footer")("TextBorder") = RGB(180, 180, 180) Theme("Footer")("TextFont") = RGB(0, 0, 0) Theme("Footer")("LabelBack") = RGB(240, 240, 240) Theme("Footer")("LabelBorder") = RGB(240, 240, 240) Theme("Footer")("LabelFont") = RGB(0, 0, 0) Theme("Button")("Back") = RGB(220, 220, 220) Theme("Button")("Border") = RGB(180, 180, 180) Theme("Button")("Font") = RGB(0, 0, 0) Theme("Button")("Hover") = RGB(200, 200, 255) Theme("Button")("Pressed") = RGB(150, 150, 220) Theme("Button")("HoverFore") = RGB(0, 0, 80) Theme("Button")("PressedFore") = RGB(255, 255, 255) Theme("Combo")("Back") = RGB(255, 255, 255) Theme("Combo")("Border") = RGB(160, 160, 160) Theme("Combo")("Font") = RGB(0, 0, 0) Theme("List")("Back") = RGB(255, 255, 255) Theme("List")("Border") = RGB(180, 180, 180) Theme("List")("Font") = RGB(0, 0, 0) End Sub '' ======= دوال مساعدة Private Function PickColorFromBase(Optional ByVal lngStartColor As Long = -1) As Long Dim cc As CHOOSECOLOR Dim aColors(15) As Long cc.lStructSize = LenB(cc) cc.hwndOwner = Application.hWndAccessApp cc.lpCustColors = VarPtr(aColors(0)) If lngStartColor <> -1 Then cc.rgbResult = lngStartColor cc.Flags = &H1 End If If CHOOSECOLOR(cc) Then PickColorFromBase = cc.rgbResult Else PickColorFromBase = COLOR_UNSET End If End Function Private Sub HandleColorPick(ByRef lngTargetVar As Long, ByVal strProperty As String, ByVal lngControlType As Long, Optional ByVal lngSection As Variant) Dim lngNewColor As Long Dim ctl As Control Dim bolMatchSection As Boolean lngNewColor = PickColorFromBase(lngTargetVar) If lngNewColor = COLOR_UNSET Then Exit Sub lngTargetVar = lngNewColor For Each ctl In Me.Controls If ctl.ControlType = lngControlType Then On Error Resume Next bolMatchSection = (IsMissing(lngSection) Or ctl.section = lngSection) On Error GoTo 0 If bolMatchSection Then On Error Resume Next CallByName ctl, strProperty, VbLet, lngNewColor On Error GoTo 0 End If End If Next ctl End Sub Private Sub ApplySectionColor(ByRef lngTargetVar As Long, ByVal lngSection As Long) Dim lngNewColor As Long lngNewColor = PickColorFromBase(lngTargetVar) If lngNewColor <> COLOR_UNSET Then lngTargetVar = lngNewColor Me.section(lngSection).BackColor = lngNewColor End If End Sub Private Sub ApplyThemePreview() Dim ctl As Control Dim sec As String If Theme("Header")("SectionBack") <> COLOR_UNSET Then Me.section(stHeader).BackColor = Theme("Header")("SectionBack") If Theme("Detail")("SectionBack") <> COLOR_UNSET Then Me.section(stDetail).BackColor = Theme("Detail")("SectionBack") If Theme("Footer")("SectionBack") <> COLOR_UNSET Then Me.section(stFooter).BackColor = Theme("Footer")("SectionBack") For Each ctl In Me.Controls Select Case ctl.ControlType Case ctTextBox Select Case ctl.section Case stHeader: sec = "Header" Case stDetail: sec = "Detail" Case stFooter: sec = "Footer" Case Else: GoTo NextControl End Select If Theme(sec)("TextBack") <> COLOR_UNSET Then ctl.BackColor = Theme(sec)("TextBack") If Theme(sec)("TextBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(sec)("TextBorder") If Theme(sec)("TextFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(sec)("TextFont") Case ctComboBox If Theme("Combo")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Combo")("Back") If Theme("Combo")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Combo")("Border") If Theme("Combo")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Combo")("Font") Case ctListBox If Theme("List")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("List")("Back") If Theme("List")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("List")("Border") If Theme("List")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("List")("Font") Case ctLabel Select Case ctl.section Case stHeader: sec = "Header" Case stDetail: sec = "Detail" Case stFooter: sec = "Footer" Case Else: GoTo NextControl End Select If Theme(sec)("LabelBack") <> COLOR_UNSET Then ctl.BackColor = Theme(sec)("LabelBack") If Theme(sec)("LabelBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(sec)("LabelBorder") If Theme(sec)("LabelFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(sec)("LabelFont") Case ctCommandButton If Theme("Button")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Button")("Back") If Theme("Button")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Button")("Border") If Theme("Button")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Button")("Font") On Error Resume Next If Theme("Button")("Hover") <> COLOR_UNSET Then ctl.HoverColor = Theme("Button")("Hover") If Theme("Button")("Pressed") <> COLOR_UNSET Then ctl.PressedColor = Theme("Button")("Pressed") If Theme("Button")("HoverFore") <> COLOR_UNSET Then ctl.HoverForeColor = Theme("Button")("HoverFore") If Theme("Button")("PressedFore") <> COLOR_UNSET Then ctl.PressedForeColor = Theme("Button")("PressedFore") On Error GoTo 0 End Select NextControl: Next ctl End Sub Private Sub EnsureThemeTableExists() Dim db As DAO.Database Dim tdf As DAO.TableDef Set db = CurrentDb On Error Resume Next Set tdf = db.TableDefs(TABLE_NAME_THEME_SETTINGS) On Error GoTo 0 If tdf Is Nothing Then db.Execute "CREATE TABLE " & TABLE_NAME_THEME_SETTINGS & " (" & _ FIELD_NAME & " TEXT(50) PRIMARY KEY, " & _ FIELD_VALUE & " LONG)", dbFailOnError End If End Sub Private Sub SaveColorSetting(ByRef rs As DAO.Recordset, ByVal strName As String, ByVal lngValue As Long) rs.FindFirst FIELD_NAME & "='" & strName & "'" If rs.NoMatch Then rs.AddNew rs(FIELD_NAME) = strName rs(FIELD_VALUE) = lngValue rs.Update ElseIf rs(FIELD_VALUE) <> lngValue Then rs.Edit rs(FIELD_VALUE) = lngValue rs.Update End If End Sub Private Sub SaveThemeToTable() Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset(TABLE_NAME_THEME_SETTINGS, dbOpenDynaset) SaveColorSetting rs, "Header_SectionBack", Theme("Header")("SectionBack") SaveColorSetting rs, "Header_TextBack", Theme("Header")("TextBack") SaveColorSetting rs, "Header_TextBorder", Theme("Header")("TextBorder") SaveColorSetting rs, "Header_TextFont", Theme("Header")("TextFont") SaveColorSetting rs, "Header_LabelBack", Theme("Header")("LabelBack") SaveColorSetting rs, "Header_LabelBorder", Theme("Header")("LabelBorder") SaveColorSetting rs, "Header_LabelFont", Theme("Header")("LabelFont") SaveColorSetting rs, "Detail_SectionBack", Theme("Detail")("SectionBack") SaveColorSetting rs, "Detail_TextBack", Theme("Detail")("TextBack") SaveColorSetting rs, "Detail_TextBorder", Theme("Detail")("TextBorder") SaveColorSetting rs, "Detail_TextFont", Theme("Detail")("TextFont") SaveColorSetting rs, "Detail_LabelBack", Theme("Detail")("LabelBack") SaveColorSetting rs, "Detail_LabelBorder", Theme("Detail")("LabelBorder") SaveColorSetting rs, "Detail_LabelFont", Theme("Detail")("LabelFont") SaveColorSetting rs, "Footer_SectionBack", Theme("Footer")("SectionBack") SaveColorSetting rs, "Footer_TextBack", Theme("Footer")("TextBack") SaveColorSetting rs, "Footer_TextBorder", Theme("Footer")("TextBorder") SaveColorSetting rs, "Footer_TextFont", Theme("Footer")("TextFont") SaveColorSetting rs, "Footer_LabelBack", Theme("Footer")("LabelBack") SaveColorSetting rs, "Footer_LabelBorder", Theme("Footer")("LabelBorder") SaveColorSetting rs, "Footer_LabelFont", Theme("Footer")("LabelFont") SaveColorSetting rs, "Button_Back", Theme("Button")("Back") SaveColorSetting rs, "Button_Border", Theme("Button")("Border") SaveColorSetting rs, "Button_Font", Theme("Button")("Font") SaveColorSetting rs, "Button_Hover", Theme("Button")("Hover") SaveColorSetting rs, "Button_Pressed", Theme("Button")("Pressed") SaveColorSetting rs, "Button_HoverFore", Theme("Button")("HoverFore") SaveColorSetting rs, "Button_PressedFore", Theme("Button")("PressedFore") SaveColorSetting rs, "Combo_Back", Theme("Combo")("Back") SaveColorSetting rs, "Combo_Border", Theme("Combo")("Border") SaveColorSetting rs, "Combo_Font", Theme("Combo")("Font") SaveColorSetting rs, "List_Back", Theme("List")("Back") SaveColorSetting rs, "List_Border", Theme("List")("Border") SaveColorSetting rs, "List_Font", Theme("List")("Font") rs.Close End Sub Private Sub LoadThemeFromCurrentForm() Dim ctl As Control Dim sec As String Theme("Header")("SectionBack") = Me.section(stHeader).BackColor Theme("Detail")("SectionBack") = Me.section(stDetail).BackColor Theme("Footer")("SectionBack") = Me.section(stFooter).BackColor For Each ctl In Me.Controls Select Case ctl.ControlType Case ctTextBox Select Case ctl.section Case stHeader: sec = "Header" Case stDetail: sec = "Detail" Case stFooter: sec = "Footer" Case Else: GoTo NextControl End Select Theme(sec)("TextBack") = ctl.BackColor Theme(sec)("TextBorder") = ctl.BorderColor Theme(sec)("TextFont") = ctl.ForeColor Case ctComboBox Theme("Combo")("Back") = ctl.BackColor Theme("Combo")("Border") = ctl.BorderColor Theme("Combo")("Font") = ctl.ForeColor Case ctListBox Theme("List")("Back") = ctl.BackColor Theme("List")("Border") = ctl.BorderColor Theme("List")("Font") = ctl.ForeColor Case ctLabel Select Case ctl.section Case stHeader: sec = "Header" Case stDetail: sec = "Detail" Case stFooter: sec = "Footer" Case Else: GoTo NextControl End Select Theme(sec)("LabelBack") = ctl.BackColor Theme(sec)("LabelBorder") = ctl.BorderColor Theme(sec)("LabelFont") = ctl.ForeColor Case ctCommandButton Theme("Button")("Back") = ctl.BackColor Theme("Button")("Border") = ctl.BorderColor Theme("Button")("Font") = ctl.ForeColor On Error Resume Next Theme("Button")("Hover") = ctl.HoverColor Theme("Button")("Pressed") = ctl.PressedColor Theme("Button")("HoverFore") = ctl.HoverForeColor Theme("Button")("PressedFore") = ctl.PressedForeColor On Error GoTo 0 End Select NextControl: Next ctl End Sub Private Sub LoadThemeFromTable() Dim rs As DAO.Recordset On Error GoTo ErrHandler Set rs = CurrentDb.OpenRecordset("SELECT * FROM " & TABLE_NAME_THEME_SETTINGS) If rs.EOF Then LoadThemeFromCurrentForm Else Do Until rs.EOF Select Case rs(FIELD_NAME) Case "Header_SectionBack": Theme("Header")("SectionBack") = rs(FIELD_VALUE) Case "Header_TextBack": Theme("Header")("TextBack") = rs(FIELD_VALUE) Case "Header_TextBorder": Theme("Header")("TextBorder") = rs(FIELD_VALUE) Case "Header_TextFont": Theme("Header")("TextFont") = rs(FIELD_VALUE) Case "Header_LabelBack": Theme("Header")("LabelBack") = rs(FIELD_VALUE) Case "Header_LabelBorder": Theme("Header")("LabelBorder") = rs(FIELD_VALUE) Case "Header_LabelFont": Theme("Header")("LabelFont") = rs(FIELD_VALUE) Case "Detail_SectionBack": Theme("Detail")("SectionBack") = rs(FIELD_VALUE) Case "Detail_TextBack": Theme("Detail")("TextBack") = rs(FIELD_VALUE) Case "Detail_TextBorder": Theme("Detail")("TextBorder") = rs(FIELD_VALUE) Case "Detail_TextFont": Theme("Detail")("TextFont") = rs(FIELD_VALUE) Case "Detail_LabelBack": Theme("Detail")("LabelBack") = rs(FIELD_VALUE) Case "Detail_LabelBorder": Theme("Detail")("LabelBorder") = rs(FIELD_VALUE) Case "Detail_LabelFont": Theme("Detail")("LabelFont") = rs(FIELD_VALUE) Case "Footer_SectionBack": Theme("Footer")("SectionBack") = rs(FIELD_VALUE) Case "Footer_TextBack": Theme("Footer")("TextBack") = rs(FIELD_VALUE) Case "Footer_TextBorder": Theme("Footer")("TextBorder") = rs(FIELD_VALUE) Case "Footer_TextFont": Theme("Footer")("TextFont") = rs(FIELD_VALUE) Case "Footer_LabelBack": Theme("Footer")("LabelBack") = rs(FIELD_VALUE) Case "Footer_LabelBorder": Theme("Footer")("LabelBorder") = rs(FIELD_VALUE) Case "Footer_LabelFont": Theme("Footer")("LabelFont") = rs(FIELD_VALUE) Case "Button_Back": Theme("Button")("Back") = rs(FIELD_VALUE) Case "Button_Border": Theme("Button")("Border") = rs(FIELD_VALUE) Case "Button_Font": Theme("Button")("Font") = rs(FIELD_VALUE) Case "Button_Hover": Theme("Button")("Hover") = rs(FIELD_VALUE) Case "Button_Pressed": Theme("Button")("Pressed") = rs(FIELD_VALUE) Case "Button_HoverFore": Theme("Button")("HoverFore") = rs(FIELD_VALUE) Case "Button_PressedFore": Theme("Button")("PressedFore") = rs(FIELD_VALUE) Case "Combo_Back": Theme("Combo")("Back") = rs(FIELD_VALUE) Case "Combo_Border": Theme("Combo")("Border") = rs(FIELD_VALUE) Case "Combo_Font": Theme("Combo")("Font") = rs(FIELD_VALUE) Case "List_Back": Theme("List")("Back") = rs(FIELD_VALUE) Case "List_Border": Theme("List")("Border") = rs(FIELD_VALUE) Case "List_Font": Theme("List")("Font") = rs(FIELD_VALUE) End Select rs.MoveNext Loop End If rs.Close Set rs = Nothing ApplyThemePreview Exit Sub ErrHandler: If DebugMode Then Debug.Print "LoadThemeFromTable >> " & Err.Number & ": " & Err.Description End Sub Private Sub ApplyThemeToAllForms() Dim frm As Object Dim ctl As Control Dim i As Integer Dim arrSections As Variant Dim sec As section Dim secName As String arrSections = Array(stHeader, stDetail, stFooter) For Each frm In CurrentProject.AllForms On Error Resume Next DoCmd.OpenForm frm.Name, acDesign, , , , acHidden If Err.Number <> 0 Then If DebugMode Then Debug.Print "تعذر فتح النموذج: " & frm.Name Err.Clear GoTo NextForm End If On Error GoTo 0 For i = LBound(arrSections) To UBound(arrSections) Set sec = Forms(frm.Name).section(arrSections(i)) Select Case arrSections(i) Case stHeader: If Theme("Header")("SectionBack") <> COLOR_UNSET Then sec.BackColor = Theme("Header")("SectionBack") Case stDetail: If Theme("Detail")("SectionBack") <> COLOR_UNSET Then sec.BackColor = Theme("Detail")("SectionBack") Case stFooter: If Theme("Footer")("SectionBack") <> COLOR_UNSET Then sec.BackColor = Theme("Footer")("SectionBack") End Select Next i For Each ctl In Forms(frm.Name).Controls Select Case ctl.ControlType Case ctTextBox Select Case ctl.section Case stHeader: secName = "Header" Case stDetail: secName = "Detail" Case stFooter: secName = "Footer" Case Else: GoTo NextControl End Select If Theme(secName)("TextBack") <> COLOR_UNSET Then ctl.BackColor = Theme(secName)("TextBack") If Theme(secName)("TextBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(secName)("TextBorder") If Theme(secName)("TextFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(secName)("TextFont") Case ctComboBox If Theme("Combo")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Combo")("Back") If Theme("Combo")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Combo")("Border") If Theme("Combo")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Combo")("Font") Case ctListBox If Theme("List")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("List")("Back") If Theme("List")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("List")("Border") If Theme("List")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("List")("Font") Case ctLabel Select Case ctl.section Case stHeader: secName = "Header" Case stDetail: secName = "Detail" Case stFooter: secName = "Footer" Case Else: GoTo NextControl End Select If Theme(secName)("LabelBack") <> COLOR_UNSET Then ctl.BackColor = Theme(secName)("LabelBack") If Theme(secName)("LabelBorder") <> COLOR_UNSET Then ctl.BorderColor = Theme(secName)("LabelBorder") If Theme(secName)("LabelFont") <> COLOR_UNSET Then ctl.ForeColor = Theme(secName)("LabelFont") Case ctCommandButton If Theme("Button")("Back") <> COLOR_UNSET Then ctl.BackColor = Theme("Button")("Back") If Theme("Button")("Border") <> COLOR_UNSET Then ctl.BorderColor = Theme("Button")("Border") If Theme("Button")("Font") <> COLOR_UNSET Then ctl.ForeColor = Theme("Button")("Font") On Error Resume Next If Theme("Button")("Hover") <> COLOR_UNSET Then ctl.HoverColor = Theme("Button")("Hover") If Theme("Button")("Pressed") <> COLOR_UNSET Then ctl.PressedColor = Theme("Button")("Pressed") If Theme("Button")("HoverFore") <> COLOR_UNSET Then ctl.HoverForeColor = Theme("Button")("HoverFore") If Theme("Button")("PressedFore") <> COLOR_UNSET Then ctl.PressedForeColor = Theme("Button")("PressedFore") On Error GoTo 0 End Select NextControl: Next ctl DoCmd.Close acForm, frm.Name, acSaveYes NextForm: On Error GoTo 0 Err.Clear Next frm End Sub الكود الان يتيح تخصيص مظهر النماذج بشكل مركزي يوفر واجهة لتحديد ألوان الخلفية للأقسام (رأس، تفاصيل، تذييل) يوفر تحديد ألوان الخلفية و الحدود والنصوص للعناصر (مربعات نص - عناوين التسمية ) لكل قسم على حده يوفر تحديد ألوان الخلفية والنصوص للعناصر (مربعات نص - مربعات التحرير والسرد - قوائم القيم - أزرار ) يدعم معاينة فورية وتطبيق الثيم على جميع النماذج بنقرة واحدة مع خيار استعادة الإعدادات الافتراضية يتم حفظ الإعدادات في جدول قاعدة بيانات مما يضمن الاتساق عبر النماذج ينشئ الجدول فى حالة عدم وجوده يحدث البيانات للاعدادت داخل الجدول فى حالة وجود الجدول وأخيرا التعديل على مرفق حضرتك changColor(2).accdb
  26. السلام عليكم الإخوة الأفاضل في هذا المنتدى الجميل في موضوعي هذا أريد التعديل على كود حفظ لحفظ الوثائق بجانب قاعدة البيانات: - فتح النموذج frm_divers_dossiers - الضغط على زر "إضافة وثيقة" - سيفتح نموذج آخر اسمه FrmAttchedFiles : في هذا النموذج أريد التعديل على كود حفظ البيانات والموجود في زر " إضافة/فتح الملف" نلاحظ وجود موظفين: موظف 1 و موظف 2 ولهما وثيقة تحمل نفس الأسم هو: 1 لكن المحتوى الداخلي للوثيقة مختلف تماما فالكود الحالي يحذف الوثائق ويبقى على وثيقة واحدة فقط لأنهما متشابهان في الإسم الكود الحالي يشتغل جيدا لكن بالصدفة أكتشفت أنه في حالة إضافة وثيقتين لهما نفس الإسم يبقى على وثيقة واحدة فقط لأنهما يقعان في نفسس المجلد (الملف) لأني أحيانا أضيف الوثائق بسرعة وليس في كل مرة يلزم أغير الإسم لأضمن أن لايتم يتعويضه هل يمكن التعديل على الكود لضمان حفظ الوثائق حتى ولو كانوا متشابهين في الإسم، أم أنه يوجد حل آخر الرجاء المساعدة والتوجيه وبارك الله فيكم baseA.accdb
  27. رغم ان المرفق عبارة عن جداول فأنا اعتذر عن الغفلة ملحوظة : كنت في اعمال لي سابقة استخرج الغياب بناء على جدول الحضور .. حيث يوجد موظفون آخرون حاضرون في تاريخ غياب الموظف الهدف وعن طريق الاستعلام والعلاقة يظهر اسم الموظف الغائب ومعرفه ولكن سجله خالي من التوقيع ........................ هنا لنفرض ان عدد الموظفين 3 او اكثر ثم غابوا جميعا في يوم واحد .. على طريقتي التي ذكرت اعلاه سوف يختفي يوم الغياب ولن يظهر لذا اريد التطبيق على موظف واحد فقط .. واعشق الاختصار في الكائنات والادوات خاصة .. اما الاكواد والدالات فلا مشكلة d6.rar غياب يوم 8 واضح حيث لا يوجد له توقيع في جدول الحضور اما الاجازة ايضا لا يوجد توقيع في جدول الحضور ولكن تم رصد هذه الاجازة في جدول الاجازات
  1. أظهر المزيد
×
×
  • اضف...

Important Information