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

وعليكم السلام ورحمة الله وبركاته 🙂 تفضل : شعار.accdb

وعليكم السلام ورحمة الله وبركاته الحقيقة لم افهم الية عمل الصلاحيات لديك .... لكن جرب هذا ربما هو ما تريد .... مثال (3).accdb

استاذ احمد @Ahmed_J استخدم هذه الدالة لتعطيك رقم دقيق ..صحيح الفرق بالايام قليل ..لكنه فرق طبعا من خلال مربع نص تمرر تاريخ التعيين وتاريخ اليوم ..سوف يعطيك سنوات الخدمة كامل اما اردت الفصل..يعني السنة مثلا في مربع نص وحده استخدم =Mid(DateDiffExact([EmpDate],Date()),1,2) وهكذا للبقية Function DateDiffExact(startDate As Date, endDate As Date) As String Dim years As Long, months As Long, days As Long Dim startY As Long, startM As Long, startD As Long Dim endY As Long, endM As Long, endD As Long startY = Year(startDate) startM = Month(startDate) startD = Day(startDate) endY = Year(endDate) endM = Month(endDate) endD = Day(endDate) years = endY - startY months = endM - startM days = endD - startD If days < 0 Then days = days + Day(DateSerial(endY, endM + 1, 0)) months = months - 1 End If If months < 0 Then months = months + 12 years = years - 1 End If DateDiffExact = years & " سنة, " & months & " شهر, " & days & " يوم" End Function

السلام عليكم ورحمة الله تعالى وبركاته اجندة مواعيد الكترونية حتى يأخذ كل ذى حق حقه المرفق مثال أجنبى تم التعديل عليه وتم استخدام افكار وأكواد من المنتدى تخص الاستاذ @أبو آدم جزاه الله خيرا وتم اضافة بعد التعديلات من العبد الفقير الى الله والتى كانت تناسبنى وقت التعديل على المرفق وتم اضافة وتطوير المرور بين الاشهر والسنوات ملاحظة هامة : تم تحديث التكويد الخاص بدوال الـ API ليدعم العمل على النواتان 32x , 64x ولكن لن استطيع التجربة فى الوقت الحالى للنواة 32x برجاء من يقوم بتجربة المرفق يذكر أصدار نواة الأوفيس الخاص بجهازه وبالأخص من يملك النواة 32x Outlook Style Calendar.mdb

قام أخي @kanory بالواجب جزاه الله خيرا 🙂 ولكن لدي ملاحظتين : 1- أعتقد أنه من الخطأ الاعتماد على اسم المستخدم لمعرفة إن كان هو المشرف أو مستخدم عادي .. فلو تم تغيير الاسم في الجدول لن يعمل معك الكود .. وأقترح أن تضيف حقل جديد من نوع (نعم/لا) يكون اسمه IsAdmin مثلا .. وعليه تبني الكود . 2- ما أجمل الكود عندما يكون مرتب بطريقة سهلة القراءة .. أولا سترتاح أنت في كتابته وتعديله والرجوع إليه .. وثانيا ستريح من يأتي بعدك لتعديله وفهمه لاحقا 🙂 .. لاحظ الفرق الآن بعد أن كان مكدسا كله على جهة اليسار 🙂 : 3- والثالثة مجانية من عندي 😎 غير اسم حقل الاسم إلى UserName مثلا .. لأن كلمة Name وحدها محجوزة للأكسس..

فكر وحاول تعملها لوحدك .... واذا لم تستطع ساعدناك ...... ( علمني كيف اصطاد ) ........ انظر ......

Try Sub Test() Dim data(), a(), b(), out(), dic As Object, dataCols As Object, i As Long data = Range("F2:S2").Value a = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row).Value Set dic = CreateObject("Scripting.Dictionary") For i = LBound(a, 1) To UBound(a, 1) If Not dic.Exists(a(i, 1)) Then dic.Add a(i, 1), a(i, 2) Else dic(a(i, 1)) = dic(a(i, 1)) + a(i, 2) Next i ReDim b(1 To UBound(data, 2)) Set dataCols = CreateObject("Scripting.Dictionary") For i = LBound(data, 2) To UBound(data, 2) If Not dataCols.Exists(data(1, i)) Then dataCols.Add data(1, i), i b(i) = dic(data(1, i)) Next i ReDim out(1 To 1, 1 To UBound(data, 2)) For i = LBound(data, 2) To UBound(data, 2) out(1, i) = b(dataCols(data(1, i))) Next i Range("F3:S3").Value = out End Sub

Private Sub TextBox3_Change() If (TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "") Then TextBox4 = TextBox1 * TextBox2 * TextBox3 Else TextBox4 = "" End If End Sub Private Sub TextBox2_Change() If (TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "") Then TextBox4 = TextBox1 * TextBox2 * TextBox3 Else TextBox4 = "" End If End Sub Private Sub TextBox1_Change() If (TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "") Then TextBox4 = TextBox1 * TextBox2 * TextBox3 Else TextBox4 = "" End If End Sub هكذا؟!

وهذه فكرة ثانية للتجربة أضف زر لإعادة التوسيط وسمه cmdRecenter ونشط الحدث عند النقر وسيكون الكود بهذا الشكل: Private Sub cmdRecenter_Click() Dim Ctl As Control Dim minX As Integer, maxX As Integer, Gap As Integer minX = Me.WindowWidth maxX = 0 For Each Ctl In Me.Controls With Ctl If .Left < minX Then minX = .Left If .Left + .Width > maxX Then maxX = .Left + .Width End With Next Ctl Gap = (Me.WindowWidth - (maxX - minX)) / 2 Gap = Gap - minX If Gap <> minX Then For Each Ctl In Me.Controls With Ctl .Left = .Left + Gap End With Next Ctl End If End Sub جربوا وخبرونا.

حبيبي الغالي اسف لك الاكسس عندي عربي فلم استطع تنفيذ توجيهات حضرتك وبعد اثراء اخي Barna بالصور التوضحيحة تبين لي ان حل كلاكما واحد فبارك الله فيكما

طبع ما في الصورة ...............

كليك يمين علي (All Access Objects)ثم ثم اضغط على (Navigation Options)بيظهرك (Navigation Options) الغي علاة الصح من البكس (show System Objects)

تفضل أخي ووافني بالرد . واذا كان هذا طلبك لاتنسى الضغط على أفضل اجابة . مذبح البركة-1 .accdb

وعليكم السلام ورحمة الله وبركاته أخي العزيز ..🙂 ستجد في المنتدى العديد من المواضيع التي تتكلم عن الإرسال بالجيميل وهي ناجحة بحمدالله .. أنظر هنا مثلا وهنا مثلا :

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

انا لاحظت انك غيرت اسم الحقل في الجدول كان اسمه ID الى userid وهو موجود في جميع الاكواد الاخرى باسم ID فقمت بتعديله الى ID تفضل Private Sub ID_AfterUpdate() On Error Resume Next Dim db As DAO.Database Dim rst As DAO.Recordset Dim i As Long i = Me.ID Set db = CurrentDb Set rst = db.OpenRecordset("SELECT * FROM tbltest WHERE tbltest.ID = " & i) With rst If !ID = i Then Me.sname = ![sname] Me.sage = ![sage] .Close Else Exit Sub End If End With Me.Refresh Set rst = Nothing db.Close Set db = Nothing End Sub اذا الاسم userid يهمك يمكنك التصحيح في الجدول وتعديله في الكود userid2.accdb

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير وفيك بارك الله ، اللهم آمين واياكم يارب بالتوفيق

وعليكم السلام ورحمه الله وبركاته اللهم آمين واياكم نعم يوجد اخى @qathi فالنموذج الاول هتشيل كلمه برايفت من الحدث Private فالنموذج الثانى تحت زر الامر Call Form_frm1.n1_AfterUpdate بالتوفيق

ومسائك سعيد أخي @TQTHAMI 🙂 أضفت لك الحقل IsAdmin في الجدول وهذه الأسطر في الكود : Dim IsAdmin As Boolean .... .... IsAdmin = DLookup("IsAdmin", "users", "[id] =" & Forms![FrmSign]!a) .... .... .... .... If IsAdmin = True Then DoCmd.OpenForm "frm2" Else DoCmd.OpenForm "frm1" End If .... .... مثال (2).accdb

السلام عليكم ورحمة الله وبركاته ملف صغير خاص بمجموعات الدعم التعليمي مجموعات الدعم أحمد الرشيدي-1.xlsx

تم بحمد الله وفضله وبتوجيهاتكم التعديل ولكن بضافة خانة للرقم القومى لتلافى الخطا السابق لترتيب الاقساط. ( للتشابه الاسم مع اختلاف المركز ). ولكم منى كل تحية وتقدير وزادكم الله من فضله وكل عام وانتم بخير بمناسبة النصف من شعبان Database151.rar

السلام عليك أخي النجاشي 🙂 جرب المرفق أخي العزيز .. قمت بعمل الكثير من التنسيقات للخلايا بحيث تم ربطها مع بعض لكي تتحرك جميعها ككتلة واحدة .. ثم أضفت مربعات على يسارها جميعا ، تكبر وتصغر تلقائيا حسب عدد الحقول .. وهذه هي الجزئية التي أضفتها في الكود ( الدالة GenerateDate ) لكي تتحكم بأحجام المربعات (w1 - w2 - w3) Dim w ' لحساب عدد الخلايا المخفية For x = 1 To 50 If Me("D" & x).Caption = "" Then w = w + 1 Me("s" & x).Width = 0 Me("DDDD" & x).Width = 0 Me("D" & x).Width = 0 Me("day" & x).Width = 0 Me("SUM" & x).Width = 0 End If Next w = 50 - w Me.w1.Width = (700 * w) Me.w2.Width = (700 * w) Me.w3.Width = (700 * w) وطبيعي جدا أن يكون هناك اختلافات في النتائج من جهاز لآخر وهذا يعتمد حسب حجم الشاشة .. لذلك إذا وجدت إزاحة كبيرة للخلايا عندك فقم باللعب في الرقم ( 700 ) الذي في الكود تكبيرا أو تصغيرا حسب الحاجة ‏‏‏‏‏‏AA - 3-4 .accdb

السلام عليكم ورحمه الله وبركاته جرب الكود التالي Me.Textbox4 = Val(Textbox1) / Val(Textbox3) / Val(Textbox2) * Val(ComboBox3) * Val(ComboBox1) * Val(ComboBox2)

تفضل أخي . زمنية-1.accdb

تفضل أخي . AA - 3-5 .accdb

دائما ينصح بتنبه المستخدم عند حذف أي بيانات محفوظة لخطورة هذه العملية فبعد الحذف لا يمكن إعادة البيانات إلا بإدخالها مرة أخرى. وكذلك التراجع فهو يشبه عملية الحذف فقد يقوم المستخدم بإدخال أو تعديل بيانات ثم في غفلة يضغط على زر "هروب" ويفقد كل ما أدخله قبل حفظه ، لذلك أرى كذلك أن ينبه المستخدم بهذا الإجراء كما في عملية الحذف تماما. بالطبع لو كان السجل عبارة عن حقول قليلة وبيانات لا تؤثر في معلومة حسابية فعملية التراجع لا تشكل هاجسا ولكن في مثل هذا المثال المرفوع وهو لأحد أعضاء المنتدى حيث يحتوي السجل على 60 حقلا تقريبا وكلها عبارة عن أرقام تؤثر في المجاميع وفي العمليات المحاسبية فلا بد من التنبيه والتحذير حتى لا يضطر المستخدم من عملية الإدخال/التعبئة لستين حقلا من جديد. وطبعا التراجع عن الحفط هذه ميزة في الأكسس وللاستفادة منها لا بد من تجنب بعض الأوامر التي تقوم بحفظ السجل عند استعمالها في الأكواد وما يحضرني منها الآن: DoCmd.Save Me.Requery Me.Refresh Me.Recalc جربوا عملية التراجع باستخدام زر هروب Esc موفقين مثال_على_التنبيه_قبل_التراجع_01.accdb

السلام عليكم 🙂 طبعا استعنت بالذكاء الصناعي لكتابة هذا الكود لك أخي ناصر 🙂 ولكي يتم تنفيذه بشكل جيد يجب أن تتحقق عدة شروط : - أن تكون هناك صياغة معينة لأرقام الهواتف في ملفات الوورد مثل : ###-####(###) مثلا .. وذلك لتخبر الكود عن ماذا يبحث بالضبط . - أن تحدد المكان الذي ستحفظ فيه الأرقام بعد استجلابها .. وكيف ستنسب كل رقم إلى صاحبه ؟ أنا أخبرته هنا أن يفتح مجموعة ملفات الوورد الموضوعة في مسار معين الواحد تلو الآخر ويبحث فيها عن أرقام الهواتف ثم ينسخها ويلصقها في جدول "Telephone_Tbl" وتحديدا في الحقل "TelephoneNumber" .. بدون تخصيصه لاسم معين .. وهذا هو الكود نقلته بدون تعديل .. وذلك للتجربته فعليا عندك وإخبارنا بالنتائج .. أو أعطنا عينة من الملفات التي عندك وقاعدة بياناتك لنجرب عليها 🙂 Sub ImportTelephoneNumbers() ' Define variables Dim objWord As New Word.Application Dim objDoc As Word.Document Dim objRange As Word.Range Dim objFolder As String Dim objFile As String Dim objTelephoneNumber As String Dim db As DAO.Database Dim rs As DAO.Recordset ' Set the folder path where the Word documents are stored objFolder = "C:\Path\To\Word\Documents" ' Open the Access database and recordset Set db = CurrentDb() Set rs = db.OpenRecordset("Telephone_Tbl") ' Loop through all files in the folder objFile = Dir(objFolder & "\*.docx") Do While objFile <> "" ' Open the Word document Set objDoc = objWord.Documents.Open(objFolder & "\" & objFile) ' Loop through the document and find all telephone numbers For Each objRange In objDoc.StoryRanges objRange.Find.Execute FindText:="(###) ###-####", MatchWildcards:=True Do While objRange.Find.Found objTelephoneNumber = objRange.Text objTelephoneNumber = Replace(objTelephoneNumber, "(", "") objTelephoneNumber = Replace(objTelephoneNumber, ")", "") objTelephoneNumber = Replace(objTelephoneNumber, " ", "") objTelephoneNumber = Replace(objTelephoneNumber, "-", "") rs.AddNew rs("TelephoneNumber").Value = objTelephoneNumber rs.Update objRange.Find.Execute Loop Next objRange ' Close the Word document objDoc.Close False ' Get the next file in the folder objFile = Dir() Loop ' Clean up and close objects rs.Close Set rs = Nothing Set db = Nothing objWord.Quit Set objWord = Nothing End Sub

وعليكم السلام ورحمه الله وبركاته اخى الكريم @محمد حمدي وبالنسبه شكل النتائج المطلوبه يمكنك عملها يدوي لنرى كيف تريد النتائج لما تضعها مثل ماهو موجود في صفحه التقرير ام ماذا العملاء.xlsb

وعليكم السلام ورحمة الله وبركاته يمكنك الاستعانة بهذا الكود في السطر الرابع تلغي تفعيل إظهار رؤوس الصفوف والأعمدة والسلام عليكم Private Sub Workbook_Open() ThisWorkbook.Application.WindowState = xlMaximized ThisWorkbook.Application.DisplayFullScreen = True ActiveWindow.DisplayHeadings = False Application.DisplayFormulaBar = False End Sub

طيب التعديلات في اضافة نموذج1 و استعلام Tat_kan و موديول Module1 افتح النموذج 1 ثم اضغط على عملية الاحتساب جرب واعلمنا بالنتيجة ..... ‏‏‏‏‏‏‏‏‏‏‏‏‏‏‏‏‏‏‏HR19-2-2023.rar

عليكم السلام نعم .. القديم يعمل على الجديد .. فقط المشكلة في النظام يجب مراعاة النواتين 32 و 64 عند كتابة الأكواد

نعم اوكد كلام الاستاذ / derbali تظهر نفس الرسالة عندى تطالب باضافة المكتبة استاذنا / على الحداد نرجو من حضرتك ايضاح كيفية اضافة هذه المكتبة ونكون شاكرين لحضرتك جزاك الله كل خير

وممكن أيضاً هكذا ضرب.xlsm

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

اهداء الى كبيرنا استاذ جعفر برنامج اثبات الحضور : * يعمل بدقة HD 1920X فقط تسطيع اعادة تصميم برنامج ليتناسب مع جميع الشاشات *لا يوجد اخطاء 1- يعرض كافة ايام الشهر بتحديد السنه اذا كانت السنه الحالية بتحديد اليوم يكون طبقا لتاريخ اليوم بأيام الشهر M/yyyyy *واجهة بسيطة لعرض السريع للتحرير والاذونات برقم المدني القومي او رقم البصمة لليوم ولا تزيد الاذونات عن اربع ايام في الشهر 2- قائمة تسجيل بصمة الدخول من ساعة 7 صباح الى 2-3 ولا يحفظ اذا لم يدرج للاضافي او تعدى وتخطا الوقت المحدد *جدول لكل سنه 12 سجل فقط يحدث آلي بعد شهر 12 لكل سنة جديده 3-اضافة وادراج موظف جديد كنت يا @Moosak عامل صح ليه غيرة P بتحديث استكمال البقية اذا كان للعمر بقية الشعر اسود نقله الى برنامجك تستطيع تطوير بدل من الوقت الى اخر عمليات او عدد الزوار في اليوم او اجمالي المبالغ باللي يناسبك وتستطيع اضافة عرض سنة كامله للموظف نموج في الواجهة فقط صف 12 شهر في فورم واحد تحميل سريع ومباشر ميديا فير size 3M https://download1523.mediafire.com/w5zzv077dgcg4wIzf0VOD5uF2rHmnJ5XAyK8x2GsC47oCLLzafCgvo54MOtBj2tnUW7y1VxB5POKaJf0og0g7riF8hw/dywzk6furjcvqty/Ezril-+Chake-UpDate-Date().rar Ezril

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

كلامك صحيح مئة بالمئة عارف المشكلة اين أخي @ابوخليل كيف يمكن من خلال جدولة التمييز بين الفترات !!!! فلذلك التصميم الصحيح للجداول مهم جدااااااااااااا اخي @ابو مهند شتية هل هنا جدول لتوزيع دوام الموظفين ..... بمعنى انا موظف لديك .... كيف اعرف ايام وفترات دوامي ؟؟؟؟ هل هنا جدول اسبوعي مثلا لتغيير هذه الفترات او شهري اوووووو .... كيف يمكن معرفة ان دوام kanory غدا 7 صباحا مثلا وليس 9 صباحا

اخي @ابو مهند شتية ممكن تزيد من عدد البيانات الموجودة في الجدول حتى نستطيع مساعدتك في هذه المشكلة ..... لاني ارى هذا الموظف بياناته مختلفة عن سابقة ... انظر .... لا حظ الموظفين ( 1001 - 1005 ) لديهم خروج دوام اول اما الموظف ( 1009 ) ليس لديه خروج دوام اول هل هناك حالات لموظفي اخرين بنفس الطريقة أم هي غلطة مطبيعة .... لانها جزء من الحل الذي افكر فيه ... ارجو التوضيح .... بارك الله فيك

وعليكم السلام ورحمه الله وبركاته تفضل Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim X If (Target.Column = 5 And Target.Row > 11) Then X = Application.Match(Target.Offset(0, -2), Sheet2.Range("C1:C" & Sheet2.Cells(Rows.Count, "C").End(xlUp).Row), 0) If Target.Value > Sheet2.Range("K" & X) Then MsgBox "noooooooooooooooo" Target.Value = "" Else Sheet2.Cells(X, 9).Formula = "=" & Sheet2.Range("I" & X) & "+" & Target.Value End If End If Application.EnableEvents = True End Sub

وعليكم السلام ورحمه الله وبركاته يمكنك ذلك بوضع زر امر علي اليوزرفورم ووضع هذا الكود به Private Sub CommandButton1_Click() If (TextBox1 <> "" And TextBox2 <> "" And TextBox3 <> "") Then TextBox4 = TextBox1 * TextBox2 * TextBox3 Else TextBox4 = "" End If End Sub

السلام عليكم ورحمة الله وبركاته وبها نبدأ اي موضوع تفضل لعله المطلوب العملاء.xlsb

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

كيفية ترحيل بيانات في نفس الشيت من غير كتابة اكواد فيجوال فيديوووووو جديددددد في هذا الفيديو هانتعلم ازاي نرحل بيانات من استخدام تعقيدات استخدام الاكواد في الفيجوال بيسك ... هانرحل بيانات في نفس الشيت بطريقة بسيطة https://youtu.be/nAdK-mKeZJM

هذا برنامج للجمعيات الخيرية وبه حل كتابة الرقم القومى وتحويله للتاريخ هل هذا ماتريد كلمة السر 1515 جنتى المعدل بنك الدم.rar

اطلع على هذا الرابط