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

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

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

برنامج الموارد البشرية HR "مفتوح المصدر" يحتوى على التالي : -بيانات الموظف . -الإجازات . - الأذنونات . - تسجيل الحضور يدوياً . - الخصومات . - السلف . - المكافأت . - تقيييم الموظف . - ساعات إضافية . - تقارير. - متابعة الحضور والانصراف . - تسجل الحضور والانصراف بشكل آلي . - تسجل الحضور بشكل يدوي . وخيارات أخرى . وهذا البرامج من تطويري وجدت جداوله في موقع خارجي . لا تنسونا من خالص الدعاء ،،، HR.rar

السلام عليكم.. موديول لـ InputBox لجعل الكتابة تظهر على شكل نجوم لمساعدتك في حماية كلمات السر او ماشابه. '---------------------------------- 'API CONSTANTS FOR PRIVATE INPUTBOX '---------------------------------- Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long '---------------------------------- 'PRIVATE PASSWORDS FOR INPUTBOX '---------------------------------- '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'March 2003 '//////////////////////////////////////////////////////////////////// Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Function InputBoxDK(Prompt, Title) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title) UnhookWindowsHookEx hHook End Function الاستدعاء بهذا الشكل: Call: InputBoxDK("Enter your Password.", "Password Required") الحقوق لاصحابها بالتوفيق للجميع حسنين

السلام عليكم, هذا جدول يوضح لكم تنسيقات الارقام في الاكسس كالعملة وغيرها. ارجو ان يفيدكم. انواع التنسيقات "5" التنسيق لعدد موجب "-5" التنسيق لعدد سالب "0.5" التنسيق لعدد عشري "0" التنسيق الخاص بالصفر Zero-length string ("") 5 -5 0.5 0 0 5 -5 1 0 0.00 5.00 -5.00 0.50 0.00 #,##0 5 -5 1 0 $#,##0;($#,##0) $5 ($5) $1 $0 $#,##0.00;($#,##0.00) $5.00 ($5.00) $0.50 $0.00 0% 500% -500% 50% 0% 0.00% 500.00% -500.00% 50.00% 0.00% 0.00E+00 5.00E+00 -5.00E+00 5.00E-01 0.00E+00 0.00E-00 5.00E00 -5.00E00 5.00E-01 0.00E00 "$#,##0;;\Z\e\r\o" $5 $-5 $1 Zero بالتوفيق للجميع

وعليكم السلام -تفضل اغلاق ملف اكسل بعد 5 دقائق بكود بدون تدخل من المستخدم وهذا كود اخر يمكنك استخدامه بوضعه فى حدث ThisWorkbook ____لإغلاق ملف الإكسيل بعد 50 ثانية كمدة خمول Dim xTime As String Dim xWB As Workbook Private Sub Workbook_Open() On Error Resume Next xTime = Application.InputBox("Please specify the idle time:", "KuTool For Excel", "00:00:50", , , , , 2) Set xWB = ActiveWorkbook If xTime = "" Then Exit Sub Reset End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) On Error Resume Next If xTime = "" Then Exit Sub Reset End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next If xTime = "" Then Exit Sub Reset End Sub Sub Reset() Static xCloseTime If xCloseTime <> 0 Then ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , False End If xCloseTime = Now + TimeValue(xTime) ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , True End Sub ثم اضافة هذا الكود بمديول عادى Sub SaveWork1() Application.DisplayAlerts = False ActiveWorkbook.Save ActiveWorkbook.Close Application.DisplayAlerts = True End Sub وهذا ملف للعمل مسجل عليه هذه الأكواد حفظ وإغلاق ملف إكسيل تلقائيا بعد وقت خمول معين.xlsm

السلام عليكم الاخ الكريم / اياد م .. بارك الله فيك تقبل خالص تحياتي اليك نفس الملف الخاص بالقدير الصديق العزيز / يحياوي .. جزاه الله خيرا ولكن بتعديل بسيط ليعمل كما تريد ( اغلاق الملف فقط بعد المدة التي تحددها في بنفسك في الكود من خمول الملف ) واليك الملف التالي قم بتجربته واخبارنا بالنتائج تقبل خالص تحياتي غلف الملف بعد مدة من ترك ملف غير نشط.xls

السلام عليكم بالنسبة لربط الشهادة (وورد) بملف إكسيل يحوي عدة شيتات غير ممكن (باستعمال خاصية "دمج المراسلات") حسب رأيي... ولحل المشكلة قمت بإنشاء شيت جديد "الشهادات" في ملف الإكسيل الذي فيه البيانات وإدراج المعادلات اللازمة لاستخراج هذه الشهادات كما تريد مع كود لطباعة كل هذه الشهادات... أرجو أن تفي الغرض المطلوب... بن علية حاجي المصنف1.xlsm

وعليكم السلام-تفضل استاذ قيس لك ما طلبت المصنف1.xlsm

قبل ان تقوم بتشفير القاعدة accde يجب أن تحتفظ بنسخه مفتوحة لديك عشان لو احتجت لها تقدر ترجع تعدل عليها ومن ثم تقوم مرة أخري بتشفيرها واستبدالها بالقاعدة المشفرة القديمة

قم بتعديل الاعدادات كما بالصورة ثم قم بتحويل صيغة البرامج الي accde ولا تنسي أخذ نسخة م البرامج قبل التغير .

تفضل اخي Forms("MyForm").ShortcutMenu = False

السلام عليكم, للاسف كنت اشرح لك بالتفصيل عمل هذه الدوال وكيفية استعمالها لكن صادف ردي مع تحديث المنتدى، وواجهت مشكلة في كتابة الرد.. عموما سارفق لك مصادر اجنبية قم بقرائتها iif.pdf IsNull.pdf Nz.pdf

السلام عليكم, كثيرا ما ازعجتني مُشكلة اضافة السجل بواسطة التاب لذلك كنت دائماً اسلك طريق الـ VBA في اضافة وتعديل السجلات برمجياً. لكن الامر طويل وشاق، قمت بالتفكير في طريق لمنع الحفظ التلقائي بالتاب او الانتر.. وجعلت الحفظ يكون عن طريق الزر، الطريقة ليست اختراع ولا شيء, لكن احببت ان اشارككم بما توصلت اليه. تحياتي, حسنين disable_auto_save.accdb

مسابقة دينية للاجابة عليها من اربع خيارات الفيديو

السلام عليكم اخي العزيز تفضل التعديل وارجو ان يكون كما طلبت Sale.rar

أستاذ tataataa أين الضغط على الإعجاب؟!!!

نعم وهو الملف الوسيط سيتكفل بهذه المهمة تم التعديل المطلوب ولتسهيل الأمر على مسؤول القاعدة اذا اراد مثلا اظهار الكائنات للتعديل أو الإطلاع تمت اضافة زر أمر لاظهار الكا ئنات وشريط الادوات بدل ما يقوم بألغاء كلمة السر ثم اعادة تفعيل الشفت وفتح القاعدة من جديد فقط نقرة زر كل شي يكون أمامه طبعا زر الأمر لازم يكون مخفي عن المستخدم ونقوم بإيجاد طريقة لاظهاره للمسؤول بالنسبةلي بما اني استخدم نظام صلاحيات مستخدمين أضع هذا الكود عند فتح النموذج لاظهار زر الأمر وتفعيله If MyUser.username() = "Kaser906" Then Me![cmd47].Enabled = True Me![cmd47].Visible = True End If الملف بالمرفقات ::بالتوفيق:: إذا كنت ترى هذه المشاركة مفيدة فلا تنسى التقييم FreeKaser906.rar

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

ممكن اعرف ايه الفائدة من عمل نسخه كل ساعة؟ سوف تتراكم النسخ الاحتياطية وتأخذ مساحة من القرص الصلب كبيرة لو افترضنا أن سوف يكون لديك في اليوم ١٠ نسخ * عدد ايام عمل البرنامج في الشهر يكفيك نسخة كل يوم او كل شهر ..

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

وعليكم السلام ورحمة الله وبركاته استبدل المجموع في الاستعلام باحدى الطرق التالية الراتب الكلي : salary([m])+salary2([n]) او الراتب الكلي: val([اراتب الاسمي])+val([العلاوة]) تحياتي

اخي @kaser906 يا ريت تضيف هذه الفقرة للبرنامج حتى يشتغل على النواتين 32بت و 64بت 🙂 جعفر

هنالك حلول اخرى غير تشفير بيانات الجداول مثل اخفاء الجداول بالكود كما في المشاركة التالية https://www.officena.net/ib/topic/97264-مطلوب-كود-عند-الضغط-علية-يعمل-hidden-للجداول-مثل-hidden-اللى-فى-properties/?do=findComment&comment=595792 بالاضافة الى قفل قاعدة الجداول بكلمة سر كما هو موضح في المشاركة التالية https://www.officena.net/ib/topic/98020-طريقتي-في-حماية-قاعدة-البيانات-من-تفعيل-الشفت-وحماية-الاستعلامات-و-وحدات-المايكرو-وكلمة-السر-للقاعدة-الخلفية/ يمكنك استخدام البرنامج في المشاركة التالية لإضافة كلمة سر لقاعدة الجداول ومن ثم تمرير كلمة السر من البرنامج الرئيسي https://www.officena.net/ib/topic/97860-إضافة-كلمة-مرور-لحماية-ملف-أكسس-و-تعديلها-و-حذفها-برمجيا/ عند دمج الطريقتين السابقتين اضمن لك انه من الصعب الوصول الى الجداول شخصياً لا انصح بتشفير بيانات الجداول تفادياً لخسارة البيانات لأي سبب

السلام عليكم حل آخر بمعية أعمدة إضافية وتنسيقات شرطية (الحروف المختلفة بين العمودين ليست مرتبة)... تم وضع الحل في ملف أخي سليم مع حلوله... بن علية حاجي Difference_new.xlsx

هناك نموذجان للحل الصفحة Salim والصفحة salim 1 من هذا الملف لا أعرف ايهما تريد Difference_new.xlsx

اظن في هذه الحالة تحويل نتيجة حالة الشرط "الشرط المطلوب تحققه" اذا True يرجع القيمة 1 بدلا عن True واذا False يرجع القيمة 0 بدلا عن False واذا لم اصيب اتمنى اساتذه المعادلات التصويب

وعليكم السلام ورحمة الله وبركاتة أخي هذا الأمر لايمكن تحقيقه ع الجداول ::بالتوفيق:: إذا كنت ترى هذه المشاركة مفيدة لا تنسى التقييم

تم تعديل الكود جرب ربما يكون ما تريد Sub trheel() Dim cl As Range, i As Integer For i = 2 To 41 For Each cl In Range("G3:G" & [G10000].End(xlUp).Row) If cl.Value = Sheets(i).Name Then If cl.Offset(0, -6).Resize(1, 7).Interior.Color = &HC0FFFF Then GoTo 1 cl.Offset(0, -6).Resize(1, 7).Copy Sheets(i).Range("A" & Sheets(i).[A10000].End(xlUp).Row + 1) cl.Offset(0, -6).Resize(1, 7).Interior.Color = &HC0FFFF End If 1: Next Next End Sub

انا استخدم 2019 وحليت المشكلة بالتعديل على الاستعلام باضافة (SELECT * FROM اسم الجدول) ورجع الاستعلام يعمل

انا صادفتني هذه المشكلة ، والحل كان: ازالة التحديث حسب نوع نسخة الاوفيس اللي عندك : اوفيس 2007/2010 – KB4484127 اوفيس 2013 – KB4484119 اوفيس 2016 – KB4484113 جعفر

بارك الله فيك وزادك الله من فضله

هذا البرنامج مفتوح المصدر اتبع التالي : عند فتح الملف أضغط باسمرار على زر الشف Shift مع الفتح وسترى محتوى البرنامج . نعم ضع هذا الكود في النموذج الرئيسي في حدث عند الإغلاق وسيقوم البرنامج بعمل نسخة احتياطية حسب ما وضعته من إعدادات . Call vback وبالتوفيق

تفضل إن شاء الله يكون المطلوب Backup.rar

رائع أخي @SEMO.Pa3x إضافة جميلة ، وبارك الله فيك ونفع الله بكم .

في حدث عند التنسيق If [رقم الفاتورة] Mod 10 = 0 Then Me.Detail.ForceNewPage = 2 Else Me.Detail.ForceNewPage = 0 End If Me.PgBrk.Visible = (Me.[رقم الفاتورة] Mod 10 = 0)

شكرا حسنين 🙂 الآن اشتغل تمام 🙂 جعفر

اهلا بالمعلم. شكرا لملاحظتك الجميلة، تم تصحيح القاعدة.. اتمنى ان تجرب الان وتخبرني النتيجة.

وعليكم السلام -اهلا بك فى المنتدى يمكنك استخدام خاصية البحث فى المنتدى فهناك مئات المشاركات تخص طلبك https://www.officena.net/ib/topic/98103-استعلام-بتصفية-ديناميكية-بالاسماء-والصورة/?tab=comments#comment-597060 https://www.zadschool.com/ms-office/9230/how-to-sort-values-in-microsoft-excel.html وهذا فيدو ايضا للشرح https://www.youtube.com/watch?v=l6PAi4r30rM

يعطيك العافية استاذ @SEMO.Pa3x وهذه الطريقة تؤدي نفس الغرض مع أمكانية التراجع

هممم اذا كتبت في حقل الاسم ، يحفظ البيانات ، اذا: 1. اغلقت النموذج ، 2. انتقلت الى السجل التالي من ازرار التنقل في اسفل النموذج 🙂 هل هذه الطرق محمية كذلك؟ جعفر

الحمدلله انك حصرت المشكلة في شيء آخر غير البرنامج 🙂 شكرا لك 🙂 جعفر

UPDATE tasjeelaldokholwlkhrog SET tasjeelaldokholwlkhrog.waketelkhoroog = Time() WHERE (((tasjeelaldokholwlkhrog.moazafbarkood)=[Forms]![atasgelee]![bar]) AND ((tasjeelaldokholwlkhrog.date)=Date())); استاذي جعفر .. فتحت الملف ع جهاز تاني وشتغل بدون مشاكل الآن !! ربما من الويندوز او نسخة الاوفيس تعطلت على الجهاز الاول والله اعلم ؟؟!!

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

تفضل المرفق يعمل جيداً الضغط على الفرعى.accdb تحياتي

السلام عليكم استخدام عمود وسيط ممكن هذا التعديل مثل الملف Sub trheel() Dim Cl As Range, i As Integer For i = 2 To 41 For Each Cl In Range("G3:G" & [G10000].End(xlUp).Row) If Not Ch(Cl) Then If Cl.Value = Sheets(i).Name Then Cl.Offset(0, -6).Resize(1, 7).Copy Sheets(i).Range("A" & Sheets(i).[A10000].End(xlUp).Row + 1) Cells(Cl.Row, "XFD") = "OK" End If End If Next Next End Sub Private Function Ch(Cl As Range) As Boolean If Cells(Cl.Row, "XFD") = "OK" Then Ch = True End Function

السلام عليكم بالامكان التحقق من القيم اذا رحلت سابقاً لايرحلها كالتالي Sub trheel() Dim Cl As Range, i As Integer For i = 2 To 41 For Each Cl In Range("G3:G" & [G10000].End(xlUp).Row) If Not Ch(Cl, i) Then If Cl.Value = Sheets(i).Name Then Cl.Offset(0, -6).Resize(1, 7).Copy Sheets(i).Range("A" & Sheets(i).[A10000].End(xlUp).Row + 1) End If End If Next Next End Sub Private Function Ch(Cl As Range, i) As Boolean If Application.CountIfs(Sheets(i).Range("A3:A" & 1500), _ Range("A" & Cl.Row), Sheets(i).Range("B3:B" & 1500), _ Range("B" & Cl.Row), Sheets(i).Range("C3:C" & 1500), Range("C" & Cl.Row), _ Sheets(i).Range("F3:F" & 1500), Range("F" & Cl.Row)) = 1 Then Ch = True End Function

السلام عليكم ورحمة الله استاذ moazshawar قمت بانشاء فورم اخر غير الذي وضعته في ملفك وهذا سيكون تجربة ترحيل بيانات الى صفحة "بيع" وان كان هذا ما تريد ساواصل مساعدتك بما اعرفه ونعمل سويا عى انشاء فورم لكل صفحة ونضع لها ازرار في الصفحة (العمليات). ان امكن قم انت بانشاء تصميم لفورم ويكون مخصص لشيت الشراء وضعه في مشاركىةتك التالية البرنامج.xlsm

تم التحديث اكثر للملف بحيث يظهر الصف الاول في كل صفحة عند الطباعة و البرنامج يتلافى الاخطاء المطبعية في اختيار عدد الصفوف ويدرج محموع اخر صفحة (حتى و لو كانت تحتوي على صفوف اقل من الصفوف المختارة) لادراج معاينة قبل الطباعة - اضغط Ctrl+ F2 طباعة ذكية salim 2.rar