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

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

في جزئية كنت ناوي اكتبها مع مشاركتي السابقة ، بس لما اخبرتني ام العيال ان الغدى جاهز ، طارت عن بالي 🙂 بعض الاوقات يكون عندنا مربع سرد فيه اكثر من عمود ، ونكون عملنا كود على الحدث "بعد تحديث" المربع ، حتى يضع قيمة العمود الثاني او الثالث في حقل او حقلين ، وعليه يكون الكود هكذا / Private Sub Form_Current() Dim nRow As Long, nColumn As Long 'nRow = رقم السطر 'nColumn = رقم العمود nColumn = 0 For nRow = 0 To Me.typ.ListCount - 1 If Me.typ.Column(nColumn, nRow) = "Y" Then Me.typ.Value = Me.typ.ItemData(nRow) Call typ_AfterUpdate '<==== Exit For End If Next i End Sub Private Sub typ_AfterUpdate() '<==== Me.Typ2 = Me.typ.Column(1) End Sub جعفر

ما مهمت عليك كيف يبقى حقل التاريخ مستقل أمام الشخص ( هل تقصد كل تاريخ في حقل خاص مثلا ) ؟؟؟؟

هل هذا هو طلبك ؟؟؟؟ New Microsoft Access قاعدة بيانات (3) (1).accdb

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

وعليكم السلام اخى @ازهر عبد العزيز اتفضل ان شاء الله يكون ما تريد وجزاها الله خيرا اختنا ومعلمتنا العزيزه زهره ام عهود بالتوفيق ان شاء الله Elements.accdb

تفضل اخي العزيز ارجو ان يكون طلبك week1.rar

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

Sub Button1_Click() Dim ws As Worksheet WkSheets = Array("ورقة1", "ورقة2", "ورقة3", "ورقة4") For Each ws In Sheets(Array("ورقة1", "ورقة2", "ورقة3", "ورقة4")) ws.Select Range("b46:n46").Formula = "=SUM(B3:B43)" Range("b47:n47").Formula = "=SUM(B7:B13,B27,B32)" Range("n2:n44").Formula = "=SUM(B2:m2)" Next ws End Sub غير المصفوفه باسماء الاوراق الاربعة لديك

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

على العموم ، صحيح ان جميع الطرق اعلاه تعطي النتيجة المطلوبة ، وذلك لأن مثال اخوي ازهر بسيط وبعمود واحد ، بينما الطريقة الصحيحة هي ، البحث عن القيمة في القائمة ( ComboBox او ListBox ) ، ومن اي عمود ، ثم اظهارها ، هكذا : rim nRow as long, nColumn as long 'nRow = رقم السطر 'nColumn = رقم العمود nColumn=0 For nRow = 0 To Me.Typ.ListCount - 1 If Me.Typ.Column(nColumn, nRow)="Y" Then Me.Typ.Value = Me.Typ.ItemData(nRow) Exit For End If Next i جعفر

جرب هذا الماكرو Option Explicit Sub No_Duplicates() Dim Dic As Object Dim Mmax%, i% Dim SH As Worksheet Set SH = Sheets("Sheet1") Set Dic = CreateObject("Scripting.Dictionary") With SH If .Range("E1").CurrentRegion.Rows.Count > 1 Then _ Range("E1").CurrentRegion.Offset(1).ClearContents Mmax = .Cells(Rows.Count, 1).End(3).Row i = 2 Do Until i > Mmax If .Cells(i, 1) <> vbNullString Then If Not Dic.exists(.Cells(i, 1).Value) Then Dic(.Cells(i, 1).Value) = IIf(IsNumeric(.Cells(i, 2)), _ .Cells(i, 2), 0) Else Dic(.Cells(i, 1).Value) = _ Dic(.Cells(i, 1).Value) + _ IIf(IsNumeric(.Cells(i, 2)), _ .Cells(i, 2), 0) End If End If i = i + 1 Loop If Dic.Count Then .Range("e2").Resize(Dic.Count) = _ Application.Transpose(Dic.keys) .Range("F2").Resize(Dic.Count) = _ Application.Transpose(Dic.items()) End If End With End Sub الملف مرفق No_tekrar.xlsm

مشاركه مع اخى واستاذى @kanory جزاه الله خيرا انظر للاستعلام q ان كان ما تريد ابنى نموذجك عليه تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق New Microsoft Access قاعدة بيانات (3)(1).accdb

مبارك الترقية استاذ حسام عن جدارة واستحقاق ان شاء الله وأعانك الله عليها

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

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

تفضل استاذ محمد..تم ضبط تنسيق عمود صفحة الإكسيل أيضاً كما تريد ... على ان يكون بهذا التنسيق [$-F800]dddd dd-mm-yyyy المصنف2.xlsm

السلام عليكم 🙂 في وجهة نظري ، اذا رأيت احد الاعضاء يرد على اسئلة الاعضاء ، واجاباته تفي بحل السؤال (من المعروف ان هناك عدة طرق لحل اي سؤال ، وهناك طرق افضل من اخرى) ، فأظل اراقب هذا العضو لمجموعة مشاركات ، حتى اتاكد من علمه ، ومواظبته للمنتدى ، ولو بشكل متقطع. عندها اقوم بترشيح ترقيته الى درجة خبير 🙂 الاخ حسام وهاب @husamwahab اهلا وسهلا بك على قائمة خبراء منتدى الاكسس 🙂 ولازال البحث مستمر لترقية بقية الاعضاء 🙂 جعفر

بالخدمة استاذي العزيز

المطلوب غير واضح ؟؟؟؟

تفضل اخي هذا بالكود ولكن ليس سريع لضخامة بياناتك EURUSD1440 (1).xlsm

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

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

في هذه الحالة ، فهي لا تُسمى قيمة افتراضية 🙂 جعفر

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

نرجع للموضوع انت ترغب في تعديل القيمة الافتراضية للحقل typ في الجدول برمجيا عن طريق زر امر لتكون القيمة الافتراضية y وتبقى القيمة ثابتة ممكن عمل ذلك ولكن اذا كان زر الامر في نفس النموذج راح تظهر لك رسالة ان الجدول مفتوح وتفشل العملية فيه اكثر من حل ومن اسهل الحلول عند تنفيذ الامر نجعل مصدر السجلات غير محدد ثم نعدل القيمة ونعيد المصدر الملف في المرفقات xy.accdb

جرب الان مع ان راسي انقلب xy (3).accdb

تفضل أخي. اذا احتجت مدى أكبر. انسخ التنسيق الى باقي الخلايا Book150 (1).xlsx

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

السلام عليكم TestEdit.mdb

السلام عليكم هناك عدة طرق لعمل ذلك و الأفضل استخدام إحدى الطريقتين في المرفق: الأولى بجلب البيانات بالدالة Dlookup من جدول الأصناف بناء على مربع السرد و الحوار الخاص برقم الصنف . الثانية بنسخ قيمة الأعمدة من مربع السرد الحوار إلى الحقول المطلوبة. هاتان الطريقتان تسمحان بالتعديل على البيانات مثل تغيير سعر الوحدة من البضاعة في مثالنا، دون تغيير القيمة الافتراضية كما هو في طريقة ربط جدولين. BringValuesFrom-A-TableToAnother.accdb

يا صديقي انت تقوم بتنفيذ الماكرو على صفحة فارغة (لأن الماكرو يعمل فقط في صفحة Taksim من اجل عدم المساس في البيانات في صفحة اخرى عن طريق الخطأ ) و كما ترى الصفحة Taksim فارغة في الملف المرفق يقوم الكود بنسخ الداتا من صفحة salim الى صفحة Taksim ثم يقوم بترتيبها حسب الرقم في الخلية S2 من الصفحة Taksim لذلك اذا اردت تعديل او اضافة او حذف شيء ما قم بذلك في الصفحة الاولى (salim) ثم اذهب الى الصفحة الثانية (Taksim) ونفذ الماكرو بالضغط على الزر مرفق ملف مع بعض التعدبلات البسيطة Talsim_by_10.xlsm

اساتذتي ومعلمي الاحباء الف الف شكر الحقيقة هذا اكثر من استحقاقي اين انا من هؤلاء الاهرامات والاساتذة الذين اتحفونا وما زالوا يتحفونا باجوبتهم شكرا لاستاذنا jjafferr والشكر موصول لاساتذتي واخوتي Shivan Rekany أحمد الفلاحجى ابو البشر Khalid Jnb ابوخليل wael_rafat أبو إبراهيم الغامدي essam rabea kha9009lid ابو محمد 316 m.r

مجهود ممتاز بارك الله فيك استاذ حاتم

اتفضل اليك هذا فانكشن والكود Option Compare Database Function MyYearTxt(YY As Integer) Select Case YY Case Is = 1: MyYearTxt = "الاول" Case Is = 2: MyYearTxt = "الثاني" Case Is = 3: MyYearTxt = "الثالث" Case Is = 4: MyYearTxt = "الرابع" Case Is = 5: MyYearTxt = "الخامس" Case Is = 6: MyYearTxt = "السادس" Case Is = 7: MyYearTxt = "السابع" Case Is = 8: MyYearTxt = "الثامن" Case Is = 9: MyYearTxt = "التاسع" Case Is = 10: MyYearTxt = "العاشر" Case Is = 11: MyYearTxt = "احدى عشر" Case Is = 12: MyYearTxt = "اثنى عشر" Case Is = 13: MyYearTxt = "ثالث عشر" Case Is = 14: MyYearTxt = "اربع عشر" Case Is = 15: MyYearTxt = "خامس عشر" Case Is = 16: MyYearTxt = "سادس عشر" Case Is = 17: MyYearTxt = "سابع عشر" Case Is = 18: MyYearTxt = "ثامن عشر" Case Is = 19: MyYearTxt = "تاسع عشر" Case Is = 20: MyYearTxt = "عشرين" Case Is = 21: MyYearTxt = "واحد و عشرين" Case Is = 22: MyYearTxt = "ثاني و عشرين" Case Is = 23: MyYearTxt = "ثالث و عشرين" Case Is = 24: MyYearTxt = "اربع و عشرين" Case Is = 25: MyYearTxt = "خامس و عشرين" Case Is = 26: MyYearTxt = "سادس و عشرين" Case Is = 27: MyYearTxt = "سابع و عشرين" Case Is = 28: MyYearTxt = "ثامن و عشرين" Case Is = 29: MyYearTxt = "تاسع و عشرين" Case Is = 30: MyYearTxt = "ثلاثين" Case Else: MyYearTxt = "" End Select End Function Private Sub first_date_AfterUpdate() Dim i As Integer Dim firDat As Date Dim YeNum As Integer firDat = Me.first_date YeNum = Me.yeart_no If Len(Me.yeart_no & "") = 0 Then Exit Sub For i = 0 To 2 Me.yeart_no = YeNum + i Me.yeart_noTxt = MyYearTxt(Me.yeart_no) Me.first_date = DateAdd("YYYY", i, firDat) Me.end_date = DateAdd("YYYY", i, firDat) - 1 DoCmd.GoToRecord , , acNewRec Next i End Sub ملاحظة : انا ضعيف في اللغة العربية لذلك قم بالتأكيد على ارقام كتابيا في فانكشن احتمال هناك خطأ فيه كتابيا واليك المثال الاجازات (2).accdb

وعليكم السلام أخى الكريم لما لا تقوم بإستخدام خاصية البحث بالمنتدى طالما لم تقم برفع ملف بالمطلوب ؟ تفضل مُجمِع البيانات للاكسيل - Excel Data Collector الإصدار الخامس دمج وتجميع عدة ملفات خارجية فى ملف واحد بالمعادلات وهذا رابط اخر دمج ملفات اكسل في ملف واحد وهذا كود اخر لهذا الموضوع Sub MergeExcelFiles() 'https://www.ablebits.com/office-addins-blog/2017/11/08/merge-multiple-excel-files-into-one/ Dim fnameList, fnameCurFile As Variant Dim countFiles, countSheets As Integer Dim wksCurSheet As Worksheet Dim wbkCurBook, wbkSrcBook As Workbook fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True) If (vbBoolean <> VarType(fnameList)) Then If (UBound(fnameList) > 0) Then countFiles = 0 countSheets = 0 Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set wbkCurBook = ActiveWorkbook For Each fnameCurFile In fnameList countFiles = countFiles + 1 Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile) For Each wksCurSheet In wbkSrcBook.Sheets countSheets = countSheets + 1 wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count) Next wbkSrcBook.Close SaveChanges:=False Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files" End If Else MsgBox "No files selected", Title:="Merge Excel files" End If End Sub وهذا كود ثانى للمطلوب Sub ConslidateWorkbooks() 'https://trumpexcel.com/combine-multiple-workbooks-one-excel-workbooks/ Dim FolderPath As String Dim Filename As String Dim Sheet As Worksheet Application.ScreenUpdating = False FolderPath = Environ("userprofile") & "DesktopTest" Filename = Dir(FolderPath & "*.xls*") Do While Filename <> "" Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True For Each Sheet In ActiveWorkbook.Sheets Sheet.Copy After:=ThisWorkbook.Sheets(1) Next Sheet Workbooks(Filename).Close Filename = Dir() Loop Application.ScreenUpdating = True End Sub

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

وعليكم السلام-كان عليك استخدام خاصية البحث بالمنتدى-تفضل تفقيط مساحة ارض

وعليكم السلام-فقط يمكنك استخدام هذه المعادلة لطلبك الجديد =SUMPRODUCT(--(TEXT(ROW(INDIRECT($C$2&":"&$E$2)),"b2dddD")=G$2))-COUNTIF($N$2:$N$16,G$2) 1تحديد عدد أيام معينة بين تاريخين.xlsx

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

اخي عامر تفضل لعله المطلوب لقد قمت بصياغة الملف وتسمية الاوراق بالانجليزي حتى يعمل الكود جيدا Sub copypaste() Dim lastrow As Integer, erow As Integer, sh1 As Worksheet, sh2 As Worksheet Set sh1 = Worksheets("sheet2") Set sh2 = Worksheets("sheet4") lastrow = sheet2.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow erow = sheet4.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row sheet4.Cells(erow, 5) = sheet2.Cells(i, 1) sheet2.Cells(i, 1).ClearContents sheet4.Cells(erow, 3) = sheet2.Cells(i, 2) sheet2.Cells(i, 2).ClearContents sheet4.Cells(erow, 7) = sheet2.Cells(i, 5) sheet2.Cells(i, 5).ClearContents Next i ThisWorkbook.Worksheets("sheet4").Columns().AutoFit lastrow = sheet3.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lastrow erow = sheet4.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row sheet4.Cells(erow, 2) = sheet3.Cells(i, 1) sheet3.Cells(i, 1).ClearContents sheet4.Cells(erow, 4) = sheet3.Cells(i, 2).Formula sheet3.Cells(i, 2).ClearContents sheet4.Cells(erow, 6) = sheet3.Cells(i, 4) Next i ThisWorkbook.Worksheets("sheet4").Columns().AutoFit End Sub tarheel‬.xls

وعليكم السلام-تفضل كشف رصد درجات المرحلة الأساسية.xlsb

أحسنت اخى الكريم عمل ممتاز بارك الله فيك

تفضل لك ما طلبت حساب القيمة الاستهلاكية.xlsm

هذا الكود يحل المشكلة Option Explicit Sub My_sum() Dim r%, S# r = 1 With Sheets("ورقة1") Do Until r > .Cells(Rows.Count, 1).End(3).Row If .Range("A" & r).Interior.ColorIndex <> xlNone And _ .Range("A" & r) = "جامعة" Then S = S + 1 End If r = r + 1 Loop: .Cells(2, 6) = S End With End Sub

Option Explicit Sub test() Dim x1, x2, lr1, lr2 Application.ScreenUpdating = False Range("f5:h100").ClearContents lr1 = Range("b" & Rows.Count).End(xlUp).Row lr2 = Range("e" & Rows.Count).End(xlUp).Row For x1 = 4 To lr1 For x2 = 5 To lr2 If Cells(x1, 2) = Cells(x2, 5) Then If Cells(x1, 3) = "A" Then Cells(x2, 6) = Cells(x2, 6) + 1 ElseIf Cells(x1, 3) = "B" Then Cells(x2, 7) = Cells(x2, 7) + 1 ElseIf Cells(x1, 3) = "C" Then Cells(x2, 8) = Cells(x2, 8) + 1 'ElseIf Cells(x1, 3) = "D" Then 'Cells(x2, 9) = Cells(x2, 9) + 1 ' 'ElseIf Cells(x1, 3) = "E" Then 'Cells(x2, 10) = Cells(x2, 10) + 1 ' 'ElseIf Cells(x1, 3) = "G" Then 'Cells(x2, 11) = Cells(x2, 11) + 1 End If End If Next Next Application.ScreenUpdating = True End Sub جرب المرفق كود حلقات تكرارية 01.xls

خلاص اخوي ما دامك مصمم الا على النسخ والالحاق نرجع الى اول مشاركة لك تم التعديل : تم اضافة زر لنسخ الديون والغياب حسب الشهر والحاقها في جدول المرتبات الطريقة او العمليات التي خلف الزر : تم الاعتماد على استعلام qry_workers لنعمل منه جدول temp مؤقت بناتج التصفية عمل جملة sql وهي عبارة عن تحديث داخل جدول المرتبات بناء على المعطيات من جدول temp آمل ان يحقق مطلوبك ويحوز على رضاك Database06.rar

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

لعلي احسنت الفهم عنك تفضل Database5.rar

عليكم السلام تم التعديل على النموذج الفرعي ومطلوبك تجده في استعلام1 يغنيك عن الاضافة الى الجداول وكما تعلم الاستعلام هو جدول ويزيد عليه ايضا Database122.rar