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

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

شوف اخي @حربي العنزي المستخدم بالعادة يتعامل مع النموذج في الحالات الاربع الاساسية اضافة تعديل حذف بحث ومع اتفاقي لرد استاذنا الفاضل @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

السلام عليكم الصق هذا الكود في حدث الفورم Private Sub UserForm_Activate() If ActiveSheet.Name <> "data" Then Me.Hide Sheets("data").Activate saad1.Show End If End Sub

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

اتفضل Prog3334.rar

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

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

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

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

تفضل راجع هذه الروابط فبها ما طلبت -فهذا افضل بالتأكيد بأن تعمل وتحاول لكى تتعلم تحويل معادلة صفيف إلى كود تحويل المعادلات إلى أكواد VBA

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

اي جدول في الاكسل يجب الا يكون فيه خلايا مدمجة تم اضافة سطر فارغ رقم 2 لازالة الدمج Option Explicit Sub TWO_IN_ONE() Dim RD As Range, RK As Range Range("M2").CurrentRegion.Clear Set RD = Range("d3").CurrentRegion.Columns(3) Set RK = Range("K3").CurrentRegion.Columns(3) With Range("M2").Resize(RD.Rows.Count) .Value = RD.Value .Offset(RD.Rows.Count).Resize(RK.Rows.Count) = _ RK.Value End With With Range("M2").CurrentRegion .Sort Range("M2"): .Interior.ColorIndex = 6 .Borders.LineStyle = 1: .Font.Bold = True End With End Sub الملف مرفق COPY_2 iN 1.xlsm

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

هنالك حلول اخرى غير تشفير بيانات الجداول مثل اخفاء الجداول بالكود كما في المشاركة التالية 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-إضافة-كلمة-مرور-لحماية-ملف-أكسس-و-تعديلها-و-حذفها-برمجيا/ عند دمج الطريقتين السابقتين اضمن لك انه من الصعب الوصول الى الجداول شخصياً لا انصح بتشفير بيانات الجداول تفادياً لخسارة البيانات لأي سبب

السلام عليكم الهدف من استعمال العلامتين -- في الدالة SUMPRODUCT (التي تعمد على الأرقام) هو لتحويل مصفوفة من TRUE و FALSE إلى مصفوفة من 1 و 0 حتى تقوم الدالة بعملها المزدوج (الضرب والجمع)... وإضافة العلامتين -- هي نفسها *1 (أي الضرب في 1)... والله أعلى وأعلم... ملاحظة: تم تجسيد الحل والشرح في الملف المرفق... بن علية حاجي test.xlsx

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

السلام عليكم فكرة ممتازة عاشت الايادي

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

جرب هذا ووافنا بالنتائج Br.rar

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

السلام عليكم جرب المرفق على الرابط التالي اكيد مع حجم البيانات الكبير بيكون بطيئ ملاحظة بسيطة على ملفك تنسيق الشيت كامل يسبب بطئ في الملف يفضل عمل بوردر فقط لمدى البيانات وليس للشيت كامل 2020_A.xlsm

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

تم تعديل الكود جرب ربما يكون ما تريد 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

بارك الله فيك وذلك بكل بساطة بالضغط على اسم الصفحة بيمين الماوس ثم اختيار View Code فسيتم فتح نافذة جديدة يمكنك لصق هذا الكود بها أو يمكنك بكل سهولة بتعميم هذا الكود على جميع صفحات الملف مرة واحدة وذلك بلصق هذا الكود بحدث ThisworkBook وذلك كما بالصورة رقم 2

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

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

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

وعليكم السلام -اهلا بك فى المنتدى يمكنك استخدام خاصية البحث فى المنتدى فهناك مئات المشاركات تخص طلبك 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 وهذه الطريقة تؤدي نفس الغرض مع أمكانية التراجع

فكرة جميلة استاذنا الفاضل بارك الله فيك تحياتي

الاخ محمد حمادة الكود بسيط ومش محتاج الملف تعلم من الفيديو

يجب وضع وسائل التواصل المباشر للنشر فى هذا القسم يرجى مراجعة المووضوع المثبت

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

تفضل المرفق يعمل جيداً الضغط على الفرعى.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