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

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

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

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

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

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

اتفضل Prog3334.rar

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

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

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

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

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

السلام عليكم ورحمه الله وبركاته اعتذر لك عن عدم سرعه الرد فكان النت مقطوع وتم اصلاحه اليوم والحمدلله اخى واستاذى الغالى @jjafferr بارك الله فيك وجزاك الله خيرا عالتوضيح كنت بطبق ففقط الاستعلام ده على مثالى اللى شوفته ولكنك وضحت انها ما تنفع محاولات للتعلم والاستفاده والتطبيق العملى يفيدنى فالتعلم اكثر من القرائه فبحاول اطبق كتير على ما اراه وربنا المستعان بالنسبه لبرنامجى فانا قمت باستخدام من قبل Last وفى النماذج استخدمت كودك الرائع مع Dlookup و Dlast والامور تمام التمام بفضل الله تعالى ثم بفضلكم تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق طبتم واهتديتم

اخي @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

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

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

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

بس اخوي انت تقارن شيئين مختلفين ، برنامجك يحتاج الى 3 حقول لعمل المجاميع الصحيحة ، بينما برنامج اختنا الفاضلة ام عهود فيه حقل واحد فقط للمجاميع ، وبما ان البرنامجين مختلفين ، فلا يمكن استخدام طريقتها في برنامجك !! خليك من هذا الكلام كله ، واخبرني شو اللي تريد تعمله بالضبط ، علشان نساعدك فيه ان شاء الله 🙂 جعفر

السلام عليكم جرب المرفق على الرابط التالي اكيد مع حجم البيانات الكبير بيكون بطيئ ملاحظة بسيطة على ملفك تنسيق الشيت كامل يسبب بطئ في الملف يفضل عمل بوردر فقط لمدى البيانات وليس للشيت كامل 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

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

استاذ @jjafferr اعتقد ان المشكلة متعلقة بتحديث 13 نوفمبر والذي ادى مشكلة استعلام تالف عند تشغيل استعلام تحديث Access Error 3340

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

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

رائع أخي @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)

ممتاز اخي SEMO.Pa3x بارك الله فيك وجعله في ميزان حسناتك

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

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

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

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

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

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

السلام عليكم استخدام عمود وسيط ممكن هذا التعديل مثل الملف 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

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