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

انت في منتدى كله خبراء وانا تلميذ لديهم انظر هل هذا جزء من اكوادك ..... Private Sub btnActivate_Click() Solved = CLng(Me.txtNum) If IsNumeric(Me.txtKey) = True Then If CLng(Nz(Me.txtKey, 0)) = 123456789 Then If Len(Me.txtCode) = 9 Then If Left(Me.txtCode, 1) = "i" Or Left(Me.txtCode, 1) = "c" Then If Right(Me.txtCode, 1) = "x" Or Right(Me.txtCode, 1) = "o" Then If IsNumeric(Mid(txtCode, 5, 1)) = True Then If IsNumeric(Mid(Me.txtCode, 3, 1)) = True Then If IsNumeric(Mid(Me.txtCode, 7, 1)) = True Then mNum = (Val(Mid(Me.txtCode, 3, 1)) + Val(Mid(txtCode, 5, 1)) + Val(Mid(Me.txtCode, 7, 1))) - 1 DLOldKey = Nz(DLookup("[OldKey]", "tblSetting"), 0) If Me.txtCode <> DLOldKey Then DoCmd.SetWarnings False DoCmd.RunSQL "Update tblSetting Set tblSetting.BaseDate=#" & Format(Date, "yyyy/mm/dd") & "#" DoCmd.RunSQL "Update tblSetting Set tblSetting.ActiveDate=#" & Format(DateAdd("m", mNum, Date), "yyyy/mm/dd") & "#" DoCmd.RunSQL "Update tblSetting Set tblSetting.OldKey='" & Me.txtCode & "'" DoCmd.SetWarnings True MB = MsgBox("Êã ÊÝÚíá ÇáäÙÇã ÈäÌÇÍ" & vbNewLine & "ÓÇÑí ÍÊì: " & DateAdd("m", mNum, Date), vbInformation, "Êã ÇáÊÝÚíá!") DoCmd.Close DoCmd.OpenForm "frmMainLogin" Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ãäÊåí ÇáÕáÇÍíÉ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If ElseIf Me.txtCode = "ÊÓÊ íÇ Úã" Then Me.txtCode = "" MB = MsgBox("Êã ÊÝÚíá ÇáäÙÇã ãÄÞÊÇ", vbInformation, "Êã ÇáÊÝÚíá!") DoCmd.Close DoCmd.OpenForm "frmMainLogin" Else Me.txtCode = "" MB = MsgBox("ßæÏ ÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtCode.SetFocus End If Else Me.txtKey = "" MB = MsgBox("ãÝÊÇÍ ÇáÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtKey.SetFocus End If Else Me.txtKey = "" MB = MsgBox("ãÝÊÇÍ ÇáÊÝÚíá ÛíÑ ÕÍíÍ¡ ÈÑÌÇÁ ÇáÊæÇÕá ãÚ ÇáãØæÑ" & vbNewLine & vbNewLine & "01018877763 - 01201456588", vbCritical, "ÝÔá ÇáÊÝÚíá!") Me.txtKey.SetFocus End If End Sub

لا نحب مثل هذه المواضيع مع شديد الاعتذار لاستاذي kanory

لتحديث ربط الجداول استخدم الكود التالي Dim strDbFile As String Dim strPassword As String Dim strConnect As String strDbFile = CurrentProject.Path & "\bb.MDB" strPassword = "19801213011" strConnect = "MS Access;PWD=" & strPassword & ";DATABASE=" & strDbFile Dim tdf As DAO.TableDef Dim db As DAO.Database Set db = CurrentDb For Each tdf In db.TableDefs ' ignore system and temp tables If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then tdf.Connect = strConnect tdf.RefreshLink End If Next لإخفاء جدول معين استخدم التالي Application.SetHiddenAttribute acTable,"Customers", True

مشاركة مع استاذي @د.كاف ياروهي لاخفاء الجداول عند المستخدم بوضع الكود التالي حين فتح النموذ الرئيسي عند المستخدم Dim db As DAO.Database Dim tdf As DAO.TableDef Set db = CurrentDb For Each tdf In db.TableDefs tdf.Attributes = acHidden Next tdf ولاعادة اضهار الجداول تستخدم acNormal بدلا من acHidden

تفضل التعديل Project2.zip

تفضل طريقة عمل اسماء العائلات ومن ثم افراد العائله من فضلك اخبارنا بالنتيجه هل هذا ماتريده OdbFaml.rar

البرنامج يعمل عندي بدون اي مشاكل لان الويندوز والاوفيس 64bit

تفضل هذا الحل تم انشاء ملف Word و اضافة تصميم البطاقة لملف الوورد و اضافة اشارات مرجعية و تم تحديد حجم الصفحة حسب الحجم في البطاقة الموجودة في التقرير قم بالتجربة ستجد انك حققت الهدف 2New.zip 1-مصطفى (122146).docx

لدي اوفيس 365 الحديث بعد 2019 نسخة 64bit

من الواضح أن البرنامج تم تصميمه وتحويله الي accde باكسس 2016 او 2019

لدي اوفيس 2013 والوندوز والافيس 64 بت .. ولم يفتح عندي .. الضاهر انه على اوفيس احدث من 2013

ماهو الحل لو اراد طباعة النموذج 7000 مرة ؟

بارك الله فيكم جميعا لقد اجبتو بأكثر من ماطلت بارك الله فيكم تستحقون كل فخر وتقدير هكذا عهدناكم سباقين للخير هكذا تعودنا وهكذا سنبقى إن شاء الله لكم مني كل فخر وتقدير وكل الاعجاب نشكر كل القائمين على هذا المنتدى الرائع ومن ساهم فى مساعدتي سابق وحاليا ومستقبلا وشكر لـ الاخ / محمد أبوعبد الله والأخ / أ / محمد صالح وكل عام والجميع بألف خير تقبلو خالص التحيه

تفضل اخي الكريم تم تعديل النموذج a1 وخصوصا زر توزيع المبلغ وتم تعديل النموذج a2 في مصدره ومصادر مربعات النصوص وتم تعديل جدول t_m الكود في زر التوزيع يراعي المبلغ المتبقي بعد عدد الاقساط اذا كان اكبر من قيمة القسط او لا لاحظ توزيع القسط والفائدة واجمالي القسط في السجل الأخير بالتوفيق ‫الأقساط ‫‬1.mdb

السلام عليكم ا/ صالح انت عندى ويندوز 64 bit ولكن اوفيس 10 هل يعمل على هذا النوع وشكرا لحضرتك

وعليكم السلام ورحمة الله وبركاته بما ان هذه الحقول غير موجودة في الجدول الاساسي اذن جرب هذا التعديل _الأقساط __1.mdb تحياتي

احسنت و تربت يداك ورحم الله والديك يا طيب

شكرا وبارك الله فيكم واسعدكم وجزاكم الله خير

هذا هو المطلوب جزيت خير

وعليكم السلام ورحمة الله وبركاته البرنامج بامتداد accde بمعنى انه لا يمكن الدخول على وضع التصميم للوحدات النمطية والنماذج والتقرير كما البرنامج مصمم على اوفيس 64 بت لذلك لن يعمل على اوفيس 32 بت تحياتي

السلام عليكم ورحمة الله وبركاته تم فرمتة الكمبيوتر وتنزيل ويندوز 10 جديد وهو نفس الويتدوز قبل الفرمته ...المهم عند فتح قاعدة البيانات تفتح ولكن الايقونات الخاصة مثلا بفتح نموذج جديد او ايقونة الخروج او ايقونة التحديث لاتعمل .... قاعدة البيانات معمولة باكسس 2003 mdb والاوفيس المستخدم حاليا 2007 ....وكان شغال تمام قبل الفرمته مع العلم ان القاعدة شغالة تمام على الجهاز الاخر ويندوز7 وافيس 2003 انا اذكر قد سبق ومريت بهذى المشكلة قديما وكان التغيير عن طريق اعدادات اللغة ولكن حاولت الان ولايوجد فائدة..اتوقع ان اوامر الماكرو لاتعمل فهل من حل لديكم مع الشكر الجزيل مقدما

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

يمكن استعمال معادلة if إذا كانت الخلية فارغة تكون قيمة المعادلة فارغة يمكن وضع هذه المعادلة في i5 =IF(A5="", "", A5) ثم سحب المعادلة افقيا وراسيا بالتوفيق

الله يرضى عليك .. ممكن رفع البيانات الزائدة كما موجود بالملف المرفق لانه عملت سابقا هكذا ولكن اكثر من الموظف يرجع ويستفسر لماذا هذه الاصفار موجودة هل توجد بيانات ناقصة كشفين في ورقة واحدة - رفع.xlsx

شكرا لك استاذي وبارك الله فيك هل يتم ذلك بدون vba عن طريق معادلات وانا شاكر لك عل الرغم اعلاه تم وبكل كفاءة وشكرا لكن اسال ان كان هناك حل عن طريق معادلة

هو ممكن لكن سيكون الشكل غير مقبول نهائيا لعمل ذلك يتم نسخ النطاق من A1:G20 ثم لصقه ابتداء من الخلية I1 مع تعديل منطقة الطباعة الى A1:O20 مرفق ملفك وبه التعديل راسي وافقي بالتوفيق كشفين في ورقة واحدة.xlsx

تفضل التعديل Me.txtstatVacation = IIf(IsNull(Me.txtDateBack), IIf(Me.txtddateend + 1 > Date, "غياب", "اجازة"), "يعمل")

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

جزاكم الله خيراً اساتذتنا الكرام ... كما هو مطلوب

نفس الحال اسماء المتواجدين لا تظهر و اسمي لا يظر اتوقع بسبب المتصفح

استاذي ومعلمى @ابوخليل شكرا لك للتوضيح استاذى ومعلمنا الفاضل / محمد صالح اين اجد اعدادات الحساب ـ واين اجد الحماية والخصوصية الاستاذ/ @طلب اكسس اشكرك عرفتنى بانى ليس وحدى

بارك الله فيك اخي الكريم وجزاك الله خير الجزاء 😍

رغم عدم الرد على السؤال الذي هو جزء من فهم المطلوب لكن جعلنا الله من المحسنين جميعا تفضل هذا ملفك بعد التعديل تم وضع تاريخ البداية والنهاية في خليتين تم وضع معادلة تجلب خلية واحدة ينطبق عليها الشروط واذا كان من المحتمل وجود اكثر من علاوة بين التاريخين يمكن سحب المعادلة افقيا بالتوفيق اظهار تاريخ فى مدة زمنيه محددة.xlsx

تفضل أخي الكريم تم اجراء بعض التعديلات حتى تتناسب مع الكود والتكرار بالتوفيق تكرار الخلايا بالكود.xlsm

هذا بسبب التحديث الأخير سوف يتم معالجة الأمر

استاذى ومعلمى الفاضل / @محمد أبوعبدالله والله انت اللى بتنور بمشاركتك وانا فعلا استفيد منك كثيرا لانك معلم بمعنى الكلمة خالص التحية والاحترام لحضرتك استاذي ومعلمى / @kanory طمنتنى الله يطمن قلبك دائما كل الاحترام لحضرتك استاذنا الكبير قوى @Eng.Qassim اولا : انا ملاحظ نشاط القوى جدا واتوقع لك مقام خبير عن قريب ثانيا : كلمة حلبى ليس لها علاقة بمصر لان اسمى "محمد حلبى" وانا طلعت الدنيا لقيت اسم جدى حلبى لم اعرف سبب تسميته بهذا الاسم مع اننا من صعيد مصر لك كل احترام وتقدير

تمام شكرا جزيلا لحضرتك

يمكنك استعمال هذا الاجراء Sub twolines2columns() Range("A2:A21").TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, Other:=True, OtherChar:=Chr(10), FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True End Sub لاحظ ان رمز السطر الجديد هو chr(10) بالتوفيق

اتفضل التعديل الحاق بشرط.accdb

حسب فهمي للمطلوب جرب هذه الدالة المعرفة بنسخ هذا الكود في،موديول جديد Function sumparts(num As String) As Long Dim n As Long, a As Long a = 0 For n = 1 To Len(num) a = a + Val(Mid(num, n, 1)) Next n If Len(CStr(a)) > 1 Then sumparts = sumparts(CStr(a)) Else sumparts = a End If End Function وبعد البحث في الانترنت عن هذا الأمر يمكن اختصار هذه الدالة إلى Function sumparts(num As String) As Long sumparts = num - 9 * Int((num - 1) / 9) End Function وطريقة استدعائها داخل الخلية =sumparts(A1) حيث A1 هي الخلية التي تحتوي على العدد المراد معرفة مجموع أرقامه ويمكن الوصول لهذا الهدف مباشرة في معادلة اكسل بهذه الصورة =A1-9*INT((A1-1)/9) بالتوفيق

قد تكون هناك خيارات اخرى و هذا احد الخيارات 1 - اعمل ملف اكسل اعطي اسم للعامود و قم بترقيمه حسب التسلسل المطلوب 2 - افتح الاستمار على الوورد، اختار mailing ثم select reciptions ثم use an exsiting list ثم اضف ملف الاكسل، ثم حدد مكان كتابة رقم الاستمارة واضغط add field و اختار اسم العامود في ملف الاكسل بعد ذلك يمكنك طباعة الاستمارات دفعة واحدة بالضغط على Finish&Merge ومن ثم طباعة الكل

جرب ترحيل قيمة مربع النص بدلا من النص Range("a1").value = me.textbox1.value مع التأكد من تنسيق الخلية التي يتم الترحيل إليها عام او رقم وبالنسبة لموضوع تسريع التنفيذ فيجب معرفة الكود المستعمل اولا بالتوفيق

يمكنك استعمال دالة الجمع المشروط sumif =SUMIF(A:A,D1,C:C) حيث d1 هي الخلية التي تحتوي على الاسم المراد جمع الأرقام المقابلة له بالتوفيق

اتفضل هذا مثال لاحد الاخوه هنا بالمنتدى لا اذكر من هو حاليا بالتوفيق myPic.rar

شكرا أخي أبو أسامة

ولمزيد من التوضيح ضع هذا الكود في حدث عند الإغلاق للنموذج docmd.quit

بارك الله فيك أخي عمار ولن يضر إضافتنا لهذا الكود أيضا كود Private Sub Form_Error(DataErr As Integer, Response As Integer) Dim DATAERRCONTINUE Select Case DataErr Case Is = 3022 MsgBox " نص الرسالة ", vbInformation, " عنوان الرسالة " Response = DATAERRCONTINUE Undo الرقم.setfocus End Select End Sub

هل هذا هو المطلوب؟ مصدر سجل النموذج جدول أزون mas_sameh_1.rar

أخي الكريم يمكنك عمل ذلك من خلال تغيير خصائص النموذج إلى منبثق ---نعم مشروط-----نعم نمط الحدود -----بلا أشرطة التمرير---- لا هذا ولا ذاك محددات السجل ----لا أزرار التنقل -----لا الخطوط المقسمة-----لا وفي حدث عند التحميل تكتب الأمر docmd.maximize مع مراعاة وضع زر للخروج من الأكسس حتى تتمكن من انهاء البرنامج ومرفق مثال على ذلك ________________.rar

لعل هذا هو ما تريد mas_sameh.rar