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

السلام عليكم اهداني اخي العزيز @حسونة حسين ملف اكسل يحتوي على جميع مواضيع منتدى اكسس وبروابط مباشرة اضعه بين ايديكم لا تنسونا من دعوات صالحات *********************** ( إضافات للموضوع - Moosak ) قمت بعمل تصميم بسيط لنموذج البحث وأضفته إلى الموضوع الرئيسي بعد أذن أستاذنا أبو خليل 🙂 بمجرد الكتابة تظهر النتائج .. لاستعراض الموضوع يتم الضغط على العنوان مباشرة النقر المزدوج على مربع البحث يعيد إظهار جميع النتائج 🙂 يمكن البحث بكلمات متفرقة في الجملة .. Search_Officena_Access.rar ********************************************** Access.rar

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

شكرا لكم احبتي على ثنائكم العطر تم نقل الروابط الى جدول اكسس مؤكد بحاجة لتحسين العمل وتسهيل البحث بعمل نموذج DataSearch.rar

معلمي الحبيب @Eng.Qassim شكر.ا ً جزيلاً لك اسئل الله ان يفرج همك وان يبلغلك ما تتمناه وترجوه في الدنيا والأخرة ... لاحرمنا منك ابدا ... خالص دعائي لك

انا عملت كما كان في سؤالك..! تفضل التعديل...ابو بسملة حصل افضل اجابة وتركها برأسي 😄 qryMax.rar

اختلف برنامجي في رمضان واحتاج الى ايام لتنظيم الوقت المتاح للمنتدى ، ولكن شدني النداء نعم انت نبهته ان هو اراد الناتج مع الكسور ووافق .. ورأيت التعديل .. كتب الله اجرك ابا احمد ، هو رأى نتيجة المهندس قاسم بلا كسور فكانت اقرب الى نفسه ولكن التطبيق من خلال الكود اكثر احترافية .. فلما عاتبته قام بالغاء افضل اجابة برجاء الحصول على نتيجة افضل . سأكون وسيط خير بينكم لعلي افوز بافضل اجابة ... دمجت الفكرتين وبفضل الله خرجت بهذا الكود آمل الاطلاع من الجميع والتقييم Function GetMonths30(Date1 As Date, Date2 As Date) As Long Dim d1, m1, d2, m2 As String Dim y1, y2 As Integer Dim sum_d, sum_m, sum_y, sum_days As Integer Dim tst1, tst2 As Long d1 = Format(Day(Date1), "00"): d2 = Format(Day(Date2), "00") m1 = Format(Month(Date1), "00"): m2 = Format(Month(Date2), "00") y1 = Year(Date1): y2 = Year(Date2) tst1 = y1 & m1 & d1: tst2 = y2 & m2 & d2 If tst2 < tst1 Then Exit Function sum_d = Abs(Int(d2) - Int(d1)) sum_m = Abs(Int(m2) - Int(m1)) * 30 sum_y = (y2 - y1) * 360 sum_days = sum_y + Abs(sum_m - sum_d) GetMonths30 = sum_days End Function months30.accdb

اذا اردت ان لاتنسخ القاعدة مرة اخرى ..يجب العمل ذلك بنفسك.. حينما تضع القاعدة على الحاسوب ..انسخ مسار القاعدة وضعها في الكود التالي ..في النموذج الذي يفتح اولا On Error GoTo frm_loadErr_handler DoCmd.Maximize DoCmd.OpenForm "frm_login" Dim PD As Variant Set PD = CurrentDb If PD.Name = "C:\Users\userName\Desktop\prevent copy.accdb" Then DoCmd.OpenForm "form1" Else MsgBox " لاتملك الترخيص" DoCmd.Quit End If frm_loadExit: Exit Sub frm_loadErr_handler: MsgBox Error.descreption, vbExclamation, "!ErrorNo.." & Err.Number Resume frm_loadExit

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

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

هذا هو المهم اخي ابو بسملة ..ربي يجازيك خيرا دنيا واخرة وجميع من نفع الناس

جزاكم الله خيرا هل تقصد هذا المثال اخى كانورى محرك بحث الأكسيس الاصدار 1.2.rar

ههههههههههه انت قدها وقدود بشمهندسنا العزيز ثم اننى لا اطمع سوى فى دعوه تنفعنا يوم لاينفع مال ولا بنون وهذه مشاركتى معك فى نفس الاستعلام مباشره test22_3.accdb

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

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

مشاركة من استاذي المهندس قاسم بعد وضع الكود الذي تفضل به البشمهندس وحول القاعدة الى accede بذلك لن يتمكن اي شخص من الدخول للاكواد .....

في هذا الموقع قسم خاص بطلبات الأعضاء بمقابل هنا اعرض طلبك والذي تريد هناك ولا تنسى تضع وسيلة تواصل معك الموقع غير مسؤول عن ما يتم من اتفاق بينكما

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

السلام عليكم 🙂 أخي العزيز @أبو امين .. لا تعجل على إخوانك .. فلا يعلم بظروفهم إلا الله .. وخصوصا منهم من قلص حصة المنتدى من الوقت في رمضان ليتفرغ للعبادة 🙂 .. والحقيقة كانت لي محاولات في تعديل ملفك ولكن .. كلها لم تنجح وتحتاج لمزيد من الوقت .. وربما لتغييرات جذرية في الكود ولكن لم أتفرغ لها .. نعم أخي @عمر ضاحى .. استخدم هذه الدالة لمبدعنا @ابو جودي 🙂 : '==============================================( MnthName) اسماء الشهور الهجرى - العربى( الميلادى) - الانجليزيى( الميلادى) - اختصارالانجليزيى( الميلادى) - القبطى - السريانى' ' .__ __. ___ .___ ___. _______ _______. ______ _______ .___________. __ __ _______ .___ ___. ______ .__ __. .___________. __ __ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | || | | | | ____| | \/ | / __ \ | \ | | | || | | | / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ `---| |----`| |__| | | |__ | \ / | | | | | | \| | `---| |----`| |__| | | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | __ | | __| | |\/| | | | | | | . ` | | | | __ | \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | | | | | | | |____ | | | | | `--' | | |\ | | | | | | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |__| |__| |__| |_______| |__| |__| \______/ |__| \__| |__| |__| |__| |_______/ ' Public Function MnthName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Hijri 'txtMonthNameHijri =MnthName(txtDate,"HJ") 'To Arabic 'txtMonthNameArabic =MnthName(txtDate,"Ar") 'To English 'txtMonthNameEnglish =MnthName(txtDate,"En") 'To English Short 'txtMonthNameEnglish =MnthName(txtDate,"EnShrt") 'To Coptic 'txtMonthNameCoptic =MnthName(txtDate,"Cpti") 'To Syriac 'txtMonthNameSyriac =MnthName(txtDate,"Syr") Dim str01 As String Dim str02 As String Dim str03 As String Dim str04 As String Dim str05 As String Dim str06 As String Dim str07 As String Dim Str08 As String Dim Str09 As String Dim Str10 As String Dim Str11 As String Dim Str12 As String If strLng = "HJ" Then str01 = ChrW("1605") & ChrW("1581") & ChrW("1585") & ChrW("1605") str02 = ChrW("1589") & ChrW("1601") & ChrW("1585") str03 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") str04 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") str05 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") & ChrW("1610") str06 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") & ChrW("1577") str07 = ChrW("1585") & ChrW("1580") & ChrW("1576") Str08 = ChrW("1588") & ChrW("1593") & ChrW("1576") & ChrW("1575") & ChrW("1606") Str09 = ChrW("1585") & ChrW("1605") & ChrW("1590") & ChrW("1575") & ChrW("1606") Str10 = ChrW("1588") & ChrW("1608") & ChrW("1575") & ChrW("1604") Str11 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1593") & ChrW("1583") & ChrW("1577") Str12 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1581") & ChrW("1580") & ChrW("1577") ElseIf strLng = "Ar" Then str01 = ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1610") & ChrW("1585") str02 = ChrW("1601") & ChrW("1576") & ChrW("1585") & ChrW("1575") & ChrW("1610") & ChrW("1585") str03 = ChrW("1605") & ChrW("1575") & ChrW("1585") & ChrW("1587") str04 = ChrW("1571") & ChrW("1576") & ChrW("1585") & ChrW("1610") & ChrW("1604") str05 = ChrW("1605") & ChrW("1575") & ChrW("1610") & ChrW("1608") str06 = ChrW("1610") & ChrW("1608") & ChrW("1606") & ChrW("1610") & ChrW("1577") str07 = ChrW("1610") & ChrW("1608") & ChrW("1604") & ChrW("1610") & ChrW("1577") Str08 = ChrW("1571") & ChrW("1594") & ChrW("1587") & ChrW("1591") & ChrW("1587") Str09 = ChrW("1587") & ChrW("1576") & ChrW("1578") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str10 = ChrW("1575") & ChrW("1603") & ChrW("1578") & ChrW("1608") & ChrW("1576") & ChrW("1585") Str11 = ChrW("1606") & ChrW("1608") & ChrW("1601") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str12 = ChrW("1583") & ChrW("1610") & ChrW("1587") & ChrW("1605") & ChrW("1576") & ChrW("1585") ElseIf strLng = "En" Then str01 = "January" str02 = "February" str03 = "March" str04 = "April" str05 = "May" str06 = "June" str07 = "July" Str08 = "August" Str09 = "September" Str10 = "October" Str11 = "November" Str12 = "December" ElseIf strLng = "EnShrt" Then str01 = "Jan" str02 = "Feb" str03 = "Mar" str04 = "Apr" str05 = "May" str06 = "Jun" str07 = "Jul" Str08 = "Aug" Str09 = "Sep" Str10 = "Oct" Str11 = "Nov" Str12 = "Dec" ElseIf strLng = "Cpti" Then str01 = ChrW("1591") & ChrW("1608") & ChrW("1576") & ChrW("1577") str02 = ChrW("1571") & ChrW("1605") & ChrW("1588") & ChrW("1610") & ChrW("1585") str03 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1607") & ChrW("1575") & ChrW("1578") str04 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1608") & ChrW("1583") & ChrW("1577") str05 = ChrW("1576") & ChrW("1588") & ChrW("1606") & ChrW("1587") str06 = ChrW("1576") & ChrW("1572") & ChrW("1608") & ChrW("1606") & ChrW("1577") str07 = ChrW("1571") & ChrW("1576") & ChrW("1610") & ChrW("1576") Str08 = ChrW("1605") & ChrW("1587") & ChrW("1585") & ChrW("1609") Str09 = ChrW("1578") & ChrW("1608") & ChrW("1578") Str10 = ChrW("1576") & ChrW("1575") & ChrW("1576") & ChrW("1577") Str11 = ChrW("1607") & ChrW("1575") & ChrW("1578") & ChrW("1608") & ChrW("1585") Str12 = ChrW("1603") & ChrW("1610") & ChrW("1575") & ChrW("1607") & ChrW("1603") ElseIf strLng = "Syr" Then str01 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") str02 = ChrW("1588") & ChrW("1576") & ChrW("1575") & ChrW("1591") str03 = ChrW("1570") & ChrW("1584") & ChrW("1575") & ChrW("1585") str04 = ChrW("1606") & ChrW("1610") & ChrW("1587") & ChrW("1575") & ChrW("1606") str05 = ChrW("1571") & ChrW("1610") & ChrW("1575") & ChrW("1585") str06 = ChrW("1581") & ChrW("1586") & ChrW("1610") & ChrW("1585") & ChrW("1575") & ChrW("1606") str07 = ChrW("1578") & ChrW("1605") & ChrW("1608") & ChrW("1586") Str08 = ChrW("1570") & ChrW("1576") Str09 = ChrW("1571") & ChrW("1610") & ChrW("1604") & ChrW("1608") & ChrW("1604") Str10 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") Str11 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") Str12 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") End If MnthName = Choose(Format(dtAnyDate, "MM"), str01, str02, str03, str04, str05, str06, str07, Str08, Str09, Str10, Str11, Str12) End Function '----------------------------End------------------------------------------------------------------------------------------- شخابيط وافكار : Date Functions - دوال التاريخ بطعم جديد وتحكم شامل

هكذا؟ Sub test() Dim r As Range Dim a Dim k&, c&, z& k = 7 Application.ScreenUpdating = False With Sheets("تقرير الوردية اليومي") a = .Cells(4, 2).Resize(, 13) For Each r In .Range("B5:B" & Cells(Rows.Count, 2).Row).SpecialCells(2, 23).Areas .Cells(r(1).Row, 2).Offset(1).Resize(r.Rows.Count, .Cells(r(1).Row, Columns.Count).End(xlToLeft).Column - 1).Copy z = Sheets("شيت مجمع").Cells(Rows.Count, 1).End(xlUp).Row + 1 Sheets("شيت مجمع").Cells(z, k).PasteSpecial Paste:=xlPasteValues k = k + 12 c = r.Rows.Count - 1 Next Sheets("شيت مجمع").Cells(z, 1).Resize(c, 6) = Application.Index(a, 1, Array(2, 4, 6, 8, 10, 13)) End With Application.ScreenUpdating = True End Sub

In the code you have this line x = ComboBox1.Value So if you don't select any option from the ComboBox1, you will get the `x` variable equals to empty and this will cause an error You can exit sub by adding this line If x = "" Then MsgBox "Select Option First":Exit Sub

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

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

تفضل أخي . DD131.accdb

تفضل أخي هذا برنامج للاستاذ كانوري الله يبارك فيه . فترة صلاحية البرنامج.mdb

بالنسبة لسؤالك فالموضوع بسيط جدا 🙂 .. وتستطيع تغيره كالتالي : 1- من نموذج Tqweem غير مكان أسماء الأيام ( انتبه فقط ليبل الأسماء وليس خلايا الأرقام ) هكذا : 2- في نموذج Tqweem_Sanawi في الأكواد تبدل هذه العبارة : بداية الأسبوع بدل : vbSaturday تصبح vbMonday هكذا : 3 - كرر الخطوة رقم واحد في التقرير Tqweem_R ... والنتيجة النهائية 🙂 :

نعم ممكن .. هاك : 🙂 تقويم سنوي.accdb

بالإذن ربما Sub test() Dim r As Range Dim a Dim k&, c& k = 7 Application.ScreenUpdating = False With Sheets("تقرير الوردية اليومي") a = .Cells(4, 2).Resize(, 13) For Each r In .Range("B5:B" & Cells(Rows.Count, 2).Row).SpecialCells(2, 23).Areas .Cells(r(1).Row, 2).Offset(1).Resize(r.Rows.Count, .Cells(r(1).Row, Columns.Count).End(xlToLeft).Column - 1).Copy Sheets("شيت مجمع").Cells(2, k).PasteSpecial Paste:=xlPasteValues k = k + 12 c = r.Rows.Count - 1 Next Sheets("شيت مجمع").Cells(2, 1).Resize(c, 6) = Application.Index(a, 1, Array(2, 4, 6, 8, 10, 13)) End With Application.ScreenUpdating = True End Sub

أو هذه مثلا 🙂 تقويم شهري.accdb

وعليكم السلام ورحمه الله وبركاته تفضل هذا الكود ( تعديل لكودك ) Sub ترحيل_البيانات() Dim Lr As Long, SH As Worksheet, WS As Worksheet Set SH = ThisWorkbook.Worksheets("تقرير الوردية اليومي") Set WS = ThisWorkbook.Worksheets("شيت مجمع") Application.ScreenUpdating = False If MsgBox("انت تريد ترحيل هذا الايصال . هل تريد الاستمرار ؟", vbYesNo + vbQuestion) = vbNo Then Exit Sub End If If SH.Cells(4, 3).Value <> "" Then With SH .Activate .Unprotect Password:="011005051002018" WS.Unprotect Password:="011005051002018" If WS.FilterMode Then WS.ShowAllData End If Lr = WS.Cells(Rows.Count, "G").End(xlUp).Row + 1 WS.Range("A" & Lr).Resize(4) = .Range("C4").Value WS.Range("A" & Lr).Resize(4).NumberFormat = "dd/mm/yyyy" WS.Range("B" & Lr).Resize(4) = .Range("E4").Value WS.Range("C" & Lr).Resize(4) = .Range("G4").Value WS.Range("D" & Lr).Resize(4) = .Range("I4").Value WS.Range("E" & Lr).Resize(4) = .Range("K4").Value WS.Range("F" & Lr).Resize(4) = .Range("N4").Value .Range("B7:M10").Copy WS.Range("G" & WS.Cells(Rows.Count, "G").End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("B13:P16").Copy WS.Range("S" & WS.Cells(Rows.Count, "S").End(xlUp).Row + 1).PasteSpecial xlPasteValues .Range("C4,G4,I4,K4,N4,D7:J10,L7:P10,D13:I16,L13:P16").ClearContents .Protect Password:="011005051002018", AllowFiltering:=True, AllowFormattingCells:=True Application.Goto WS.Range("C4") WS.Protect Password:="011005051002018", AllowFiltering:=True, AllowFormattingCells:=True End With Else MsgBox "الرجاء وضع التاريخ و ملئ البيانات" SH.Activate SH.Range("C4").Select Exit Sub End If Application.ScreenUpdating = True End Sub