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

السلام عليكم ورحمة الله وبركاته ,, الاخوة الكرام كل عام وحضراتكم بخير موضوعنا اليوم جديد وقد يهم الكثير من مستخدمى الاكسس , من المعروف ان الاكسيس يمكنه ضغط ملف او فك ضغطه باستخدام اوامر الشل الخاصة بالويندوز كما لو انك استخدمت الخاصية الموجودة فى الصورة وفى رأيى لا يمكن الاستفادة منها بهذا الشكل وبالتالى قمت بتصميم برنامج .Net يتكامل مع برنامج الاكسيس ويقوم بالتالى : 1- ضغط ملف / مجلد وحمايته برقم سرى . 2-فك ضغط ملف مضغوط برقم سرى . نبذة عن منطق التصميم والبرمجة : كان من الطبيعى انى اقوم بانشاء جدول او اكثر فى الاكسيس لحفظ البيانات المطلوبة ومسارات الملفات واقوم بقراءتها بالبرنامج الجديد ولكن فكرت فى طريقة اكثر احترافية وهى عمل المطلوب بالكامل فى الاكسيس وتمرير المسارات والارقام السرية من متغيرات VBA الى Arguments الخاصة بالبرنامج الجديد وكانت النتيجة جيدة بفضل الله . يتم فتح البرنامج عن طريق هذا الكود : Call Shell("""" & MyApp & """ """ & Operation & """ """ & strSource & """ """ & strDest & """ """ & zipPwd & """", 1) حيث يتم تمرير نوع العملية اولا وذلك لأن البرنامج يقوم ب3 وظائف , وبالتالى نوع العملية تقوم بتوجيه البرنامج للوظيفة المطلوبة ثم بالمسارات والباسوردات الخاصة بها سواء ضغط او فك ضغط يقوم بترجمتها بمعرفته . انظر للامثلة المرفقة : مثال لضغط ملف وحمايته بباسورد بضغطة زر وبكل سهولة وسرعة : مثال لفك ضغط الملف بالمثال السابق : ملحوظة : بالنسبة للامتداد الذى يتعامل معه البرنامج هو zip فقط وبالتالى لن يصلح لباقى الصيغ . اعذرونى ملحقتش اعمل تصميم جذاب ولكن المهم الفكرة . بالاضافة الى ان اكواد VBA يمكن اختصارها وتحسينها بواسطة الاساتذة . مرفق برنامج الاكسيس + البرنامج المساعد .. طبعا الموضوع متعوب عليه المطلوب فقط دعوة فى هذه الايام المباركة جزاكم الله خير . فى انتظار آرائكم ومقترحاتكم بعد التجربة .. دمتم بخير Zip-UnZip Access Amr Ashraf.rar

السلام عليكم ورحمة الله تعالى وبركاته ان اليوم هو ١ ذى الحجة ١٤٤٣ هـ اول ايام العشر من ذى الحجة اسأل الله العلى القدير أن يوفقنا وإياكم فيهن لما يحبه ويرضاه من الأعمال الصالحة وأن يتقبل منا ومنكم إنه خير من سئل و أجود من أعطى وأعظم من غفر وأبر من أجاب كل عام وأنتم إلى الله أقرب وعلى طاعته أدوم ومن الجنة أدنى و أقرب وعن النار أبعد ولفعل الخيرات أسبق و لسنة النبى ألزم ولحب إتباعه أصدق كل عام وأنتم بألف ألف خير عمر مديد بإذن الله فى ظل رضى الله وطاعته عمر مديد بإذن الله مع أحبائكم عمر مديد بإذن الله وأنتم تنعمون بثوب الصحة والعافية عمر مديد بإذت الله وأنتم فى سعادة ورغد وهناء

ذكريات و تحديث اذاعات البث المباشر تحديث المرفق اعادة تفعيل الـ Shift تقليل حجم مستوى الصوت عتج الفتح ازالة روابط اذاعات بث الغناء اخص بكل الشكر والعرفان بالجميل اخى الحبيب الاستاذ @Amr Ashraf لتنبيهى لتدارك خطأى عبر نشر اذاعات بث الغتاء اللهم انى استغفرك واتوب واليك اللهم اغفر لى يارب وارحمتى واعفو عنى يارب العالمين Radio (V2).mdb

مميزات الشيت و طريقه التعامل معه تكويد العاملين و هنا بيانات العميل يتم إضافة جميع الموظفين بها وبياناتهم يومية السلف يتم تسجيل جميع سلف الموظيف الصغيره يتم خصمها في نفس الشهر&الطويلة تخصم كل شهر يتم خصم السلف مستحقة السداد في نفس الشيت اذا كانت صغيرة او طويلة يرجي كتابة تاريخ الشهر صحيح كشف حساب السلف تقرير عن سلف الموظفين الصغيرة والطويلة البونص والجزاءات تسجيل للموظفين البونص والجزاءات الحضور والغياب تسجيل حضور الموظفين بـ1 الغياب بـ0 المرتبات يتم ترحيل جميع البيانات للشيت يرجي فقط تغير بداية الشهر ونهايته من اعلي الشيت كما موضح بالداخل كشف حساب المرتبات اختيار اسم الموظف وطباعة تقرير بالمرتب بمجرد تسجيل الحضور والانصراف و تحديد السلف – والعقوبات وعند ادخالها سيتم تخصيم المبالغ من المرتب حسب الشهر و اعداد كشف المرتبات و أيضا قيد المرتبات الشهري بشكل تلقائي يمكن تسجيل و متابعه سلف الموظفين عمل جدوله لسلف الموظفين علي اكثر من شهر جميع المعادلات مفتوحه المصدر و قابله للتعديل ( حيث ان الشيت بدون اي حمايه علي المعادلات لسهوله التعديل عليه ) بيان بمفردات المرتب لكل موظف عن الشهر مع سهوله التبديل في بيان مفردات المرتب بين الموظفين بالاخيار من قائمه بجميع الموظفين بالشركه الملف حجمه صغير فلا يستدعى الأمر وضع رابط خارجى ... تــــم رفع الملف هنا مباشرة 5-2022مرتبات.xlsx

طيب و يما ان السؤال كان على اعتبار ان اسم الحقل txtQty اجعل timer interval=300 وفي حدث on timer للنموذج ضع الكود التالي Dim colorA As Long Dim colorB As Long Select Case Nz(Me.txtQty, "") Case Is = "" Case 1 To 5 colorA = 255 colorB = 16711680 With Me.txtQty .BackColor = (IIf(.BackColor = colorA, colorB, colorA)) End With Case 6 To 10 colorA = 128 colorB = 32768 With Me.txtQty .BackColor = (IIf(.BackColor = colorA, colorB, colorA)) End With End Select قم بوضه القيم من 1 : 5 تحصل على مربع يضئ ويطقئ بألوان وغير القيم من 6 : 10 تحصل على مربع يضئ ويطقئ بألوان مختلفة المرفق تم تحديث المرفق LightSystem.mdb

اولا انا وما املك ملك يمينكم >>---> العشق الممنوع طيب ليه فى اختلاف فى الاعداد حضرتك ت حسبت اجمالا واستخدمت التقريب فى الكسور انا لم احسب اجماالا ولذلك لم احصل على كسور ولم استخدم التقريب بس ... عند التحدث فى هذا الصدد لن تحصل اطلاقا على قيمة صحيحة بنسبة 100% طيب تعالى نوضح بعض النقاط الهامة تحتوي السنوات الكبيسة على 366 يومًا ، وليس 365 كم يوما يجب أن يكون للشهر؟ 28 أو 29 أو 30 أو 31؟ ومع الاخذ فى الاعتبار إن الوقت الذي تستغرقه الأرض حتى تدور حول الشمس على وجه الدقة يقترب من 365.25 يوما وبذلك يكون عدد الأيام فى الشهر = 365.25/12=30.4375 لذلك فإنه من أجل ضمان أن تظل مواسم التقويم الميلادية متزامنة مع المواسم الشمسية، يتم وضع يوم إضافي في التقويم الميلادي كل أربع سنوات وذلك سوف نقوم باستخدم الكود الاتى فى وحدة نمطية والافضل الحساب على اعتبار ان السنه 365.25 الوقت الذي تستغرقه الأرض حتى تدور حول الشمس ومع ذلك تم المراعاة اثناء كتابة الكود بجعل الاختيار حسب الرغبة اومااااااااااااااااااال Function GetPeriod( _ intContDays As Long, _ Optional intBetween_0_Or_1_LangEng_Or_Ar As Byte = 0, _ Optional intBetween_0_Or_1_ContDaysOfYear As Byte = 0) As String Dim YearAvg As Double, MonthAvg As Double Dim Y As Long, M As Long, D As Long Dim strYears As String, strMonths As String, strDays As String Select Case intBetween_0_Or_1_ContDaysOfYear Case Is = 0: YearAvg = 365: MonthAvg = 30 Case Is = 1: YearAvg = 365.25: MonthAvg = 30.4375 End Select Y = Int(intContDays / YearAvg) M = Int((intContDays - (Int(intContDays / YearAvg) * YearAvg)) / MonthAvg) D = intContDays - ((Y * YearAvg) + (M * MonthAvg)) Select Case intBetween_0_Or_1_LangEng_Or_Ar Case Is = 0: strYears = " year" & " , ": strMonths = " Month" & " , ": strDays = " Day" Case Is = 1 strYears = ChrW("32") & ChrW("1587") & ChrW("1606") & ChrW("1607") & " , ": strMonths = ChrW("32") & ChrW("1588") & ChrW("1607") & ChrW("1585") & " , ": strDays = ChrW("32") & ChrW("1610") & ChrW("1608") & ChrW("1605") End Select GetPeriod = Y & strYears & M & strMonths & D & strDays End Function على ان يتم استدعاؤه بشكل مرن باختيار الية الحساب على اعتبار ان السنة 365 و عدد ايام الشهر 30 او على اعتبار ان السنة 365.25 و عدد الأيام فى الشهر = 365.25/12=30.4375 syntax ويتم استدعاء الكود من خلال GetPeriod(CountDays, Lang(0 or 1) ,Option Calc for Cont Dayes Of Year(0 or 1)) وهذه جملة Sql والخاصة بالاستعلام للحصول على النتيجة النهائية كما بالمرفق SELECT tbldata.EmpCode, Sum(DateDiff("d",[fromDate],[ToDate])) AS NoDays, GetPeriod(Sum(DateDiff("d",[fromDate],[ToDate]))) AS FinalDurationBy365Eng, GetPeriod(Sum(DateDiff("d",[fromDate],[ToDate])),0,1) AS [FinalDurationBy365,25Eng], GetPeriod(Sum(DateDiff("d",[fromDate],[ToDate])),1) AS FinalDurationBy365Ar, GetPeriod(Sum(DateDiff("d",[fromDate],[ToDate])),1,1) AS [FinalDurationBy365,25Ar] FROM tbldata GROUP BY tbldata.EmpCode; واخيرا المرفق ملك يمينكم يا @سجى الكعبي و عبى يابا و ضيف للمكتبة يا سيدى طبعا لا اقصد مكتبة @Moosak EmploymentPeriods (V2).accdb

وعليكم السلام اجعل timer interval=1000 وفي حدث on timer للنموذج ضع الكود التالي Private Sub Form_Timer() If Me.txtQuantity < 5 Then If Me.txtQuantity.BackColor = vbWhite Then Me.txtQuantity.BackColor = vbRed Me.txtQuantity.ForeColor = vbWhite End If Else Me.txtQuantity.BackColor = vbWhite Me.txtQuantity.ForeColor = vbBlack End If End Sub txtQuantity مربع نص داخل النموذج يمثل الكمية مثلا

يمكنك تجربة هذا التعديل تم إضافة شرط عدم زيادة عدد الأرقام السرية عن عدد العشرة بالمائة من الحضور بالتوفيق محضر العشرة بالمائة.xlsb

لنفترض انه لدينا ملف يحتوي على ثلاثة أوراق عمل shets1_shets2_shets3 يقوم هذا الكود بنسخ وتصدير شيت 2و3 على سطح المكتب Sub export_sheets() Dim Fname As String, ws As Worksheet Application.DisplayAlerts = False Sheets(Array("Shets2", "Shets3")).Copy For Each ws In ActiveWorkbook.Sheets ws.UsedRange = ws.UsedRange.Value Next ws ActiveWorkbook.SaveAs Filename:= _ "C:\Users\PC Hicham\Desktop\" & "إسم الملف المستخرج" & ".xlsx", FileFormat:=51 ActiveWorkbook.Close Application.DisplayAlerts = True End Sub لاتنسى تغيير مسار حفظ الملف على حسب الموجود عندك

لا يمثل غلطة في اعتقادي على كل حال المتغيرات التي تمثل ارقام صحيحة Byte يمثل عدد فردي من 0 الى 250 Integer عدد صحيح من -32,768 الى 32,767 Long عدد صحيح طويل من -2,147,483,648 الى 2,147,483,647 LongLong عدد صحيح طويل من -9,223,372,036,854,775,808 الى 9,223,372,036,854,775,807 LongPtr عدد صحيح طويل لانظمة 32 بت من -2,147,483,648 الى 2,147,483,647 وهو البديل عن LongLong توجد متغيرات تتعامل مع الارقام كمزدوج وعملة وكسر عشري في هذه الحالة فان الاختيار الصحيح Long وايضا LongLong اذا كنا سنعمل على 64 فقط تحياتي

اى اى دايب دوووووووووووووب ☺️ انا بالاول كتبت الكود هنا بالمنتدى دون مرفق لانى كنت مستعجل وقتها ههههههههه يعنى ما كنت اكتب الكود بمحرر اكواد الاكسس وهاد مثل ما ينحكى غلطة الشاطر بألف

ليس مستحيل اخي قاسم LongLong ضمن الخيارات عندما تعلن عن متغير وتمثل نوع بيانات عدد صحيح طويل لانظمة 64 بت تتراوح قيمته من -9,223,372,036,854,775,808 الى 9,223,372,036,854,775,807 فاذا كنت تستخدم access 32 فانك سوف تحصل على خظا اما انظمة 64 بت فسوف يعمل

انا متفاجئ...طب العمل دة حصل ازاي ... انت بمجرد تكتب As بتطلعلك الخيارات ومستحيل تتكتب مزدوجة الا في حالة واحدة ...انه محمد عصام دايب لششتوا في الحب 🤣

هدية حلوة .... شكرا لك ... وكل عام انتم بخير

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

وعليكم السلام تفضل هذا الملف لأحد الاساتذة .... اتمني ان يلبي طلبك الملف حفظ عدد من الاوراق.xlsm

السلام عليكم ورحمة والله تعالى وبركاته طيب ببساطه انظر للسلسلة النصية الاتية "Moh8202281012343434" ونريد التعديل عليها لتظهر بهذا الشكل "Moh-820-228-101-234-343-4" او بهذا الشكل "Moh,820,228,101,234,343,4" او بهذا الشكل Moh820/228101/234343/4 يتم عمل ذلك من خلال الكود الاتى Function ReFormat(ByVal strText As String, Optional strSymbol As String = "-", Optional intCountDigits As Integer = 3) Dim i As Long ReFormat = "" For i = 0 To Len(strText) - 1 Step intCountDigits If i = 0 Then ReFormat = Mid(strText, i + 1, intCountDigits) Else ReFormat = ReFormat & strSymbol & Mid(strText, i + 1, intCountDigits) End If Next i End Function syntax code ReFormat(string ,Symbol, Count Digits) Result By default syntax used ReFormat(string) Symbol >-->> - Count Digits >-->> 3 اذا من خلال استدعاء الكود عن طريق البنية المفضلة الاتية: ReFormat(string) تحصل على اضافة العلامة - بعد كل 3 مواضع فى السلسلة النصية اما اذا اردت التعديل فى شكل الرمز وعدد المواضع يمكنك استخدام الكود الاتى : ReFormat(string ,Symbol, Count Digits) مثلا لو اردت استخدام الرمز $ بدلا من الرمز - وتريد وضع الرمز فى السلسلة النصية بعد كل خمس مواضع يكون الكود كالأتى: ReFormat(string ,"$", 5)

جزاكم الله خير , فكرة جميلة

الله الله الله ... شكرا على الهدية الرااااااااااائعة ... 😊🌹

شيء عجيب دكتور ..ليه اتكررت عندك Long المفروض هي واحدة

------------------------ لفد وضعت الكود على اعتبار تعدد القيم وتعدد الالوان تبعا لتعدد القيم بوجه عام الكود بكل بساطه Dim colorA As Long: colorA = 255 Dim colorB As Long: colorB = 16711680 With Me.txtQty .BackColor = (IIf(.BackColor = colorA, colorB, colorA)) End With

جرب ...عليك بربط الزر بالماكرو المسمى test ...كليك يمين على الزر ثم Assing macro ثم كليك يسار على test ثم OK نموذج بيانات الموردين.xlsm

@ابو جودي الله يحفظك يا عبقري ويزيدك من واسع علمه وفضله ... 😊 وعبي يابا .. 😂

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

المطلوب غير واضح لي بصورة كافية ربما لو ارفقت الملف مع توضيح المطلوب بمنتهى التفصيل تنتهي المشكلة بإذن الله

بعد إذنك باش مهندس محمد @ابو جودي 🙂 اشتغلت على نفس ملفك وعملت كل العمليات في كويري واحد .. وطلع عندي نتيجة قريبة منك بفارق يومين لكل شخص ( إزاااااي ؟؟ ... متسألنيش ) 😂 اسم الكويري : Qry_Moosa_Calc EmploymentPeriods.accdb

يمكنك استعمال دالة sumifs للجمع باكثر من شرط في الخلية D6 =SUMIFS(Data!D:D,Data!C:C,C6,Data!A:A,">="&$C$4,Data!A:A,"<="&$E$4) بالتوفيق

بعد التجربة الدالة راااائعة ما شاء الله ويمكن تطبيقها على أكثر مما تتصور ، واحتياجات متعددة 🙂 .. وهذه بعض الأمثلة : 1 2 3 4 5 6 7 8 9 1-2-3-4-5-6-7-8-9 12-34-56-78-9 1234-5678-9 1/2/3/4/5/6/7/8 A/B/C/D/E/F/G م ح م د ع ص ا م شـــكـــرا

وعليكم السلام ورحمة الله وبركاته ..🙂 ألف شكر باش مهندس محمد ..🌹 وعلى طول نجرب ونقول ينقل للمكتبة اللي بالي بالك 😁

الف شكر اخي الكريم المعادله شغاله

بدون زر ادخل قيمة في المدى J8:J1000 وسيرحل الى الشيت الاخر باذن الله تحياتي ...الكود في حدث الشيت Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim ws As Worksheet Set ws = Sheets("البيانات") Dim c, x Application.ScreenUpdating = False If Not Intersect(Target, Range("j8:j1000")) Is Nothing Then c = Target.Offset(, -9) x = Application.Match(c, ws.Columns(1), 0) 'Target.Copy ws.Cells(x, 1).Offset(, 19) = Target End If Application.ScreenUpdating = True End Sub ترحيل ارقام من شيت الى شيت.xlsm

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

تفضل How To Find And Replace Fill Color In Excel?

إذا كنت تقصد أن عدد الاحتياطي زاد عن الواحد في كل مجموعة في المادة الواحدة فهنا يجب أن تتغير المعادلة لأن المعادلة الأولى تجلب أول اسم أمامه ( ح ) فقط على العموم تم تعديل المعادلة في الجزء العلوي بحيث يتم سحبها أفقيا ورأسيا بسهولة بدلا من استعمال معادلة مختلفة لكل صف وإضافة معادلة الاحتياطي لأكثر من واحد يمكنك استعمال هذه المعادلة في الخلية C4 وسحبها أفقيا ورأسيا حتى K27 =IF(MOD(ROW(),2),INDEX(data!$C$19:$C$32,MATCH($B3,data!D$19:D$32,0)),INDEX(data!$C$4:$C$17,MATCH($B4,data!D$4:D$17,0))) وهذه معادلة الاحتياطي في الخلية D28 ويمكن سحبها أفقيا ورأسيا حتى K31 =IFERROR(INDEX(data!$C$4:$C$32,SMALL(IF(data!D$4:D$32=$B$28,ROW($1:$29)),ROW()-27)),"") بالتوفيق

لك جزيل الشكر

يا ستي الكريمة ..الظاهر انك لم تقرأي التعليقات السابقة الخانة الاولى في النموذج فعلا تظهر الناتج = 22سنة +0شهر+3 يوم لان الكود يحسب الشهر 30 فقط اما الخانة الثانية فتظهر العمر بشكل مضبوط ...اذا جربتي الكود يوم غد سيظهر لك العمر = 22سنة +0 شهر +0 يوم اما الخانة الثالثة والتي تعود لاستاذ موسى فلم اجربها بصراحة

السلام عليكم ورحمة الله وبركاته اعتذر لقلة حضورى بسب بعض الظروف القهرية فى الوقت الراهن ولكن امر على المنتدى من حين لاخر مرور الكرام وهذا المرفقين المرفق ضد النسخ لاى جهاز أخر ولا تعمل القاعدة الا بالرقم الخاص بالتفعيل الخاص لكل جهاز ومرفق لتوليد رقم التفعيل وهذه المشاركة تم فيها الشرح تقصيلا Anti Copy 3.accdb Key.accdb