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

السلام عليكم ورحمه الله وبركاته الصلاه والسلام على من لا نبي بعده سيدنا محمد وعلى آله ومن والاه الى يوم القيامه بعدد كل نفس انت اعلم بها يارب العالمين اخوانى واخواتى الاحبه استخدمنا دوال DMax و DCount بجانب الاكواد البرمجيه لعمل الترقيم التلقائى من المعروف ان CurrentRecord تاتى برقم السجل الحالى عندما نضعها بمصدر عنصر تحكم حقل غير منضم =CurrentRecord واليوم رأيت ترقيم تلقائى CurrentRecord فى هذا المثال المرفق لاحد الاخوه لا اعلم من هو صراحه المثال عندى منذ زمن جزاه الله خيرا فاننى اعرضه للاستفاده ولينول صاحب المثال دعوه عن ظهر غيب والدال على الخير كفاعله ثم قمت باضافه زر الحذف للنموذج وبعد الحذف يقوم باعاده الترقيم تلقاء نفسه للسجل عند الوقوف على السجل تقبلوا تحياتى وتمنياتى لكم بالتوفيق ترقيم تلقائي.mdb

السلام عليكم ورحمة الله احببت انا اشاركم ببعض الامثلة المفيدة والتي تعلمتها ولعلي كل فترة ارفق في هذه المشاركة بعض الامثلة المثال الاول احضار الحساب الاب والابناء وابناء الابناء الخ دون استخدام الدالة like المثال الثاني سيكون عن استخدامات Data shaping والتي تستخدم في انشاء recordsets within recordsets ضمن ADO OBJECT والتي نستخدم في العرض الشجري للبيانات PARENT.accdb

تفضل لعله يكون هذا طلبك Select Case MsgBox(Prompt:="هل تريد إكمال عملية إشعار المقبولين ؟", Title:=Compan, Buttons:=vbYesNo + vbInformation + vbDefaultButton1 + 1572864) Case vbYes Dim RC As Integer Dim i As Integer Dim rst As Variant Dim T As String Set rst = CurrentDb.OpenRecordset("Select * From QrySet where [rashaqa]=" & Me.a & "") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC txtMessage = "السلام عليكم أ." & qsplit(rst.leader_name, 0) & vbCrLf & _ "تم قبولك في دورة" & vbCrLf & rst.school_name & _ vbCrLf & "المكان" & vbCrLf & rst.marhala & _ vbCrLf & "نهاية الرسالة" T = send(URLEncode(UserName), URLEncode(Password), ConvertToUnicode(txtMessage.Value), txtSender.Value, rst.phone1.Value) ShowResult T updateBalance rst.MoveNext Next i rst.close: Set rst = Nothing txtMessage = "" MsgBox "لقد تمت العملية بنجاح" Case vbNo MsgBox "تم الرجوع" End Select test.accdb

تم تصحيح الماكرو ليتعامل مع جميع الأعمدة Option Explicit Sub SALIM_S_Macro() Dim DIC As Object Dim S As Worksheet Dim my_rg, cel, F_rg As Range Dim First_ad$, Act_ad$, ro%, col% Set DIC = CreateObject("Scripting.Dictionary") Set S = Sheets("salim") For Each cel In Range("h7:Ac100") If cel <> vbNullString Then DIC(cel.Value) = vbNullString End If Next Set my_rg = S.Range("aF7").CurrentRegion If my_rg.Rows.Count <> 1 Then my_rg.Offset(1).Resize(my_rg.Rows.Count - 1, 6).ClearContents End If S.Range("aF8").Resize(DIC.Count) = _ Application.Transpose(DIC.keys) '+++++++++++++++++++++++++++++++++++++++++++++++ For Each cel In S.Range("aF8").Resize(DIC.Count) Set F_rg = S.Range("h7:Ac100").Find(cel, lookat:=1) If Not F_rg Is Nothing Then First_ad = F_rg.Address: Act_ad = First_ad Do ro = S.Range(Act_ad).Row Select Case Cells(ro, 3) Case "عربية": col = 1 Case "رياضيات": col = 2 Case "فرنسية": col = 3 Case "علوم ط": col = 4 Case "فيزياء": col = 5 End Select cel.Offset(, col) = S.Cells(ro, 2) Set F_rg = S.Range("h7:Ac100").FindNext(F_rg) Act_ad = F_rg.Address If Act_ad = First_ad Then Exit Do Loop End If Next DIC.RemoveAll: Set DIC = Nothing Set my_rg = Nothing: Set S = Nothing Set F_rg = Nothing End Sub Prof_Madda2.xlsm

اولاً ازالة دمج الخلايا من الجدول الثاني مطلوبة لحسن عمل الكود (تمت المعالجة) ثانياً تم تغيير اسم الصفحة الى SALIM لسهولة التعامل مع الكود من حيث النسخ واللصق (استعمل دائما أسماء الصفحات باللغة الأجنبية) ثالثاً تم تكبير الجدول الاساسي ليستوعب حوالي 100 صف الكود Option Explicit Sub TEST() Dim DIC As Object Dim S As Worksheet Dim cel As Range Dim my_rg As Range Set DIC = CreateObject("Scripting.Dictionary") Set S = Sheets("salim") For Each cel In Range("h7:Ac100") If cel <> "" Then DIC(cel.Value) = "" End If Next Set my_rg = S.Range("aF7").CurrentRegion If my_rg.Rows.Count <> 1 Then my_rg.Offset(1).Resize(my_rg.Rows.Count - 1, 6).ClearContents End If S.Range("aF8").Resize(DIC.Count - 1) = _ Application.Transpose(DIC.keys) S.Range("aG8").FormulaArray = _ "=IFERROR(INDEX($B$7:$B$100,MATCH($AF8&AG$7,$H$7:$H$100&$C$7:$C$100,0)),"""")" S.Range("aG8").AutoFill Destination:=S.Range("AG8:AK8") S.Range("AG8:AK8").AutoFill Destination:=S.Range("AG8:AK" & DIC.Count + 6) S.Range("AG8:AK" & DIC.Count + 6).Value = _ S.Range("AG8:AK" & DIC.Count + 6).Value DIC.RemoveAll: Set DIC = Nothing Set my_rg = Nothing: Set S = Nothing End Sub الملف مرفق Prof_Madda.xlsm

السلام عليكم أخي الكريم شرح سريع للحل يمكنك إختيار فترة الترحيل بالدقائق من الأسهم عند الخلايا N1:N4 والتي تغير بالخلية M2 أو N2 وهي التي تحدد فترة الترحيل بالكود ثم بإستخدام هذا الكود يتم مقارنة الفترة منذ آخر ترحيل وبناءا عليها يتم أو لايتم عمل النسخ من البيانات لم أحذف الباينات في الشيت الأول ، فقط نسختها <<يمكن جعل الكود يمسحها بعدما تترحل >> وفي آخر الكود يطلب تشغيل كود آخر وظيفته تشغيل عداد زمني بالفترة المطلوبة ليطلب بعدها تشغيبل الكود الأول مرة أخري Sub AutoTarheel() Sheets(1).Activate e = Now - [j1] x = [n2] / 24 / 60 If e >= x Then With Sheets(2) LR = .[A9999].End(xlUp).Row If LR <> 1 Then LR = LR + 1 [A1:F20].Copy .Cells(LR, 1) End With [j1] = Now End If Call Rept ' for starting timer again End Sub Sub Rept() t = "00:" & Format([n2], "00") & ":00" Application.OnTime Now + TimeValue(t), "AutoTarheel" End Sub تفضل الملف وبه الكود dddata.xlsm

السلام عليكم أخي الكريم جرب تستخدم هذا الكود Sub nnn() cycle = WorksheetFunction.CountA([N8:N30]) - 1 If cycle < 2 Then Exit Sub lr = Cells(999, 1).End(xlUp).Row For c = 1 To cycle T = Cells(c + 8, "N") n = Cells(c + 8, "O") old = Cells(c + 8, "P") nw = Cells(c + 8, "Q") rep = 0 For r = 9 To lr A = Cells(r, "C") B = Cells(r, "D") If B = old And A = T And rep < n Then With Cells(r, "D") .Value = nw .Interior.Color = 212 End With rep = rep + 1 End If Next r Next c End Sub أو تفضل الملف به الكود تغير الفصول.xlsm

السلام عليكم حسب فهمي لطلبك عملت لك نموذجين الاول لادخال البيانات والثاني لغرض المعاينة ويمكن الاستغناء عنه وحذفه وعملت لك تقرير يظهر لك ماقمت بادخاله من بيانات ملاحظة : لم اقم بتنسيق النماذج او التقرير بصورة جيدة لاني عملتها بسرعة. اعلمنا بالنتائج تحياتي Database1.rar

السلام عليكم اقدم لكم هذه الطريقة التي اتوقع انها جديدة بحيث يتم تلوين نتيجة البحث في الحقول لتمييزها مرفق صور ومرفق قاعدة البيانات أي سؤال او استفسار جاهزين للاجابة عليه ان شاء الله بحث مع الوان.accdb

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

تسلم ايدك اخى خالد تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

السلام عليكم تفضل اخي اتمنى يكون المطلوب تحياتي ask access.rar

السلام عليكم متابعة لموضوع الأستاذ @احمد الفلاحجي أضع بين أيديكم هذه الوحدة النمطية لترقيم النموذج في حقل غير منضم، وتعتمد الدالة AbsolutePosition 'Aspen201173@yahoo.com ' نقلاً عن الأستاذ أزهر 2013 Public Function RowNum(frm As Form) As Variant On Error GoTo Err_RowNum With frm.RecordsetClone .Bookmark = frm.Bookmark RowNum = .AbsolutePosition + 1 End With Exit_RowNum: Exit Function Err_RowNum: If Err.Number <> 3021& Then Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description End If RowNum = Null Resume Exit_RowNum End Function ويتم استدعاء الدالة بجعل مصدر الحقل الغير منضم =RowNum([Form]) الشكر للأستاذ الغائب AZHAR الذي نقلت عنه هذا الكود AUTONUM.accdb

جزاكم الله كل خير

استاذي الفاضل عبد اللطيف سلوم والنعم منك يا طيب جزاك الله خيرا ممنون منك ماقصرت ربي يحفظك يارب

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

انظر الى الملف المرفق فترى ان كل شيء كما تريد 12.xlsm

السلام عليكم لقد بدلت الأحداث فجعلت البحث عن التكرار في بعد التحديث، بينما أبقيت على أمر نقل الصورة في حدث قبل التحديث. Photog_2.rar

اخي العزيز هل تريد فقط مجموع الايرادات ومجوع الصرفيات بالاستعلام؟ ام ماذا؟ وضح سؤالك اكثر اخي الكريم مرفق الملف بعد التعديل تحباتي ask access.rar

بارك الله فيك استاذنا الفاضل / @احمد الفلاحجي وجزاك الله كل خير

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

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

الحمد لله وجزاك الله خيرا

السلام عليكم الافضل ان ترفق لنا ملفك لغرض التعديل لجعل الصورة خلفية للنموذج - افتح النموذج في وضع التصميم و من خصائص النموذج اختر تنسيق ثم صورة ثم اقتح المستعرض الخاص بالصور تحياتي

تفضل المطلوب تغير الفصول.xlsm

للوهله الأوله لللموضوع ظننا انه سهل ويسير ولكنه شاق وطويل لم اتطرق حتي الأن لعملية النقل يومين لتجهيز مصفوفة عناوين الملفات الفرعية والملف الرئيسي ولكني بإذن الله لها اولا : لن اقوم بالنسخ فهو مع كثرة الخلايا وعشوائية مكانها سيكون الكود طويل وممل اكثر مما هو طويل فعلا علاوه علي مشاكل النسخ في حالة الدمج سوف يتم قراءة الملف الفرعي خلية خلية ثم تعبئة الرئيسى خلية خلية حسب مصفوفات العناوين ثم اجراء التنسيق علي الرئيسي دفعة واحدة وعلي ذلك احتاج مثال لتنسيق العمودين D و E واذا كان هناك اي تنسيقات خاصه اخري ارجو وضع مثال لها ثانيا : اما بالنسبه ل B3 و B4 لقد لاحظتهما ولن يكون هنا مشكلة تحياتي

ممكن نسخة تجريبية؟

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

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم الكود التالي Private Sub Command4_Click() Dim Per_name As String Per_name = (" حكمت سليمان ") Per_name = TrimAll(Per_name, " ") MsgBox Per_name End Sub Function TrimAll(thisString As String, thisSeparator As String) As String Dim sepPosition As Integer, lastPosition As Integer Dim j As Integer, i As Integer, s As Integer, trimmed As String s = 1: j = 1: trimmed = "" Do sepPosition = InStr(j, thisString, thisSeparator) If sepPosition = 0 Then lastPosition = j j = sepPosition + 1 Else j = sepPosition + 1 trimmed = trimmed + Mid$(thisString, s, sepPosition - s) s = j End If Loop While j <> 1 TrimAll = trimmed & Mid$(thisString, lastPosition, 100) End Function تحياتي

السلام عليكم تم عمل الاوائل حسب المجموع الكلي اخر العام بالنسبة للدوائر اين مكانها في خانة مجموع المادة اام كل الخانات لا يوجد في ملفك شهادات اخر العام تحياتي المصنف2.xlsb المصنف3.xlsb

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

حاولت لكن ما استطعت ظهرت هذه الرسالة ولا اعرف كيف اعمل تعديل على قاعدة البيانات مش عارف ايش قصدهم ب HasModule

السلام عليكم اضافة الى ماتفضلوا به الاخوان هنا مثالين اخرين عن اعادة الترقيم بصورة تلقائية للاخوان بالموقع تحياتي db1.rar اعادة الرتقيم التلقائي بالاكسس.rar

جرب المرفق مع ملاحظة تغيير اسم حقل رقم الكتاب الوارد التسميات العربية المركبة تسبب مشاكل مع الاكواد مع اعتزازنا باللغة العربية وحبنا لها Microsoft Access قاعدة بيانات جديد.accdb

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

جرب هذا لعله يفي الغرض المصنف3.xlsx

ولا يهمك والحمدلله الذى بنعمته تتم الصالحات المشاركه قبل الاخيره والتى بها استعلام التوحيد اخطأت فيها ولم انتبه لها الا بعد مشاركتك وتقول بحث بمعيار ولايضاحها ارفق لك المثال بعد التعديل لتراه ايضا ولاكن من الافضل الابتعاد عن هذا الاستعلام قدر الامكان لكلام اساتذتنا انه بطىء نوعا ما ونصيحه من اخوك احمد المبتدا قبل المضى قدما فى برنامجك حاول القرائه اكثر عن قواعد البيانات العلائقيه نحن نتعلم سويا واتعلم منكم ومن اسئلتكم فليس لى مصدر آخر للتعلم جزاهم الله كل خير اخواننا واساتذتنا الذين نتعلم منهم كل يوم تقبل تحياتى وتمنياتى لكل وللجميع بالتوفيق مرتبات(1)(1).rar

شوف التعديل ده واستعلم على المدرسه على حسن تعليم اساسى ووافنا بالنتيجه تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق مرتبات(2).rar

الشكر لله اخى ابوصلاح اذا كنت تريد 3 استعلامات فى استعلام واحد فسيتم عمل استعلام توحيد لجمعهم كالتالى شوف استعلام واحد ثم بناء التقرير عليه استعلم عن مدرسه على حسن تعليم اساسى فى استعلام 1 لعله يكون طلبك شوف المرفق بعد التعديل مرتبات(1).rar

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

كما تفضل الاخ احمد يوسف جزاه الله خيرا ماهو المطلوب عمله حتى يقوم الاساتذة بعمله ؟ مع ذلك انا لاحظت بعض المشاكل وحلها ولعله هو المطلوب . والا ابدا بشرح المشكلة وماهو المطلوب لكم تحياتي كتاب++.xlsm

بارك الله فيك استاذ بن علية حاجي بعد اذن حضرتك ولإثراء الموضوع هذا حل اخر Sallary.xlsx

السلام عليكم جرب المرفق لعل فيه ما تريد (بتصرف)... بن علية حاجي NEWS.xlsx

شكرا اخي جزاك الله خيرا

السلام عليكم اخى الفاضل اهلا ومرحبا بك لو بحثت فى القسم ستجد الكثير من مواضيع البحث ولو ارفقت مثال لما تطلب ستجد ما تريد وزياده وارفق لك مثالين للبحث بالرقم من الملفات الموجوده لدى وجزاهم الله خيرا اساتذتنا على ما قدموه من شروحات وافيه تقبل تحياتى وتمنياتى بالتوفيق بحث_برقم_وبالاسم.mdb كود استعلام.mdb

السلام عليكم ورحمة الله اعمل في مؤسسة نقليات محتاج ملف اكسل يومية صندوق (شكل الكشف/ اسم الحساب-سند قبض - سند صرف - رقم السند - البيان - التاريخ ) مع امكانية عمل كشف حساب لكل اسم حساب

استبدل الكود السابق بهذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub If Not Intersect(Target, Range("D6:D115")) Is Nothing Then If Target.Value = 4 Then Target.Offset(, 2).ClearContents End If End Sub

ربما كود بهذا الشكل يفي بالغرض Sub Test() If Range("A1").Value = "No" Then Range("B1").ClearContents End Sub

تفضل اخي محمد هذا ما تبحث عنه SQL_Net.rar

اخي محمد لعلك تجد ضالتك في المرفق. والله الموفق. Convert an Access Database to SQL Serve1.rar