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

السلام عليكم و رحمة الله و بركاته ماشاء الله عليك يا ابا عبدالله استفدنا كثير من مشاركتك الذهبية و فعلا كود رائع‘ وتحية لاستاذ الغالي ابا خليل الذي هو سبب الغنيمة هذا. و لتغير لون خلفية حقول بدلا من خلفية تفصيل قمت باضافة بسيطة على الكود كما في مرفق. UP-db1.mdb

وعليكم السلام ورحمة الله وبركاته تفضل يا غالي Option Compare Database Option Explicit Dim X1 As Boolean Private Sub GroupHeader0_Format(Cancel As Integer, FormatCount As Integer) If X1 Then Detail.BackColor = 16777199 Else Detail.BackColor = 14877777 End If X1 = Not (X1) End Sub UP-db1.mdb تحياتي

ربما هذا الكود يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column = 1 And Target.Count = 1 And _ Application.CountIf(Range("salim_rg"), Target) <> 0 And Target.Offset(1) = "Total" Then ADD_rows (Target.Row) With Target.Offset(2, 1) .Formula = "=sum(B3:B" & Target.Row & ")" .Offset(, 1).Formula = "=sum(C3:C" & Target.Row & ")" .Offset(, 2).Formula = "=sum(D3:D" & Target.Row & ")" End With End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++++++++++++ Sub ADD_rows(n%) Dim MyRows As Integer MyRows = Range("A3").CurrentRegion.Rows.Count + 2 Rows(n + 1).Insert Shift:=xlDown Cells(n, 1).Offset(, 1).Resize(, 3).Formula = _ "=VLOOKUP($A" & n & ",salim_rg,COLUMNS($A$1:A1)+1,0)" End Sub الملف للمعاينة مرفق Auto_Load.xlsm

تفضل الحل في الصورة لا يمكن العمل لانه لا مجال لرؤية اعمدة الخلايا ولا صفوفها (من اين اعرف اني اتعامل مع الخلية D2 واستنتاج المطلوب من الخلية F2 مثلاُ) و بالتالي كيف تكتب معادلة Exemple.xlsx

ياسلام عليك يابو عبدالله تصدق الكود هذا موجود عندي استخدمه في تفصبل التقرير للتمييز بين الأسطر ولم يخطر ببالي لمستك الرقيقة الساحرة بانشاء مقطع الــ id الف شكر وسلمت أناملك

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

السلام عليكم هذه 3 ملفات للاخوة بالمتدى اتمنى ان تكون هي المطلوب تحياتي ClosePro-M.rar Demo Version.rar إيقاف بالمدة.rar

عذرا لخطاء غير مقصودة PhotoD.rar

تفضل أخي @مازن الحسيني وأعلمنا بالنتيجة ..... مثال.rar

شرح مختصر وافي وللفائدة بحثت عن بقية رموز العناصر فخرجت بهذه النتيجة : 126 - acAttachment 108 - acBoundObjectFrame 106 - acCheckBox 111 - acComboBox 104 - acCommandButton 119 - acCustomControl 103 - acImage 100 - acLabel 102 - acLine 110 - acListBox 114 - acObjectFrame 105 - acOptionButton 107 - acOptionGroup 124 - acPage 118 - acPageBreak 101 - acRectangle 112 - acSubform 123 - acTabCtl 109 - acTextBox 122 - acToggleButton

وياك وياك اخي العزيز

جزاك الله خيرا اخى @Abu Farid وكود جميل وممتاز بارك الله فيك وزادك الله من فضله وعلمه تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

ابشر استاذنا رقم 109 هو رمز نوع عنصر مربع نص (حقل) يمكن تغيره الى If TypeOf ctl Is TextBox Then و هذا لاستثاء حقول مراد تغير لون خلفيته من باقي عناصر محتمل وجودهم في تفصيل كـ تسمية، إطار... و Backstyle هو نمط خلفية عنصر و رقم 1 هو خيار الثاني في خاصية نمط خلفية عنصر(عادي) و 0 هو خيار الاول (شفاف) وفي حال اختيار خيار شفاف مسبقا، لا ينطبق عليه الكود يجب جعله اول عادي ثم تغير لون خلفيتة في الكود

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

وعليكم السلام-يمكنك استخدام وتطويع هذا الكود Sub SplitWorkbook() Dim FileExtStr As String Dim FileFormatNum As Long Dim xWs As Worksheet Dim xWb As Workbook Dim FolderName As String Application.ScreenUpdating = False Set xWb = Application.ThisWorkbook DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") FolderName = xWb.Path & "\" & xWb.Name & " " & DateString MkDir FolderName For Each xWs In xWb.Worksheets xWs.Copy If Val(Application.Version) < 12 Then FileExtStr = ".xls": FileFormatNum = -4143 Else Select Case xWb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If Application.ActiveWorkbook.HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum Application.ActiveWorkbook.Close False Next MsgBox "You can find the files in " & FolderName Application.ScreenUpdating = True End Sub

اخي اليك احد محاولات FILTER.accdb

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه frm_Main ، وبه حقل الاسم fName ، وحقل التاريخ:من Date_From ، وحقل التاريخ:الى Date_To ، والحقول في الاستعلام ، حقل الاسم fName ، وحقل التاريخ DateX . 1. اذا اردنا البحث عن اسم كامل (وليس جزء من اسم) ، فيجب ان يكون المعيار في الاستعلام: [forms]![frm_Main]![fName] 2. واذا كان حقل الاسم فارغا في النموذج ، ونريد ان نرى جميع الاسماء ، فالمعيار يصبح: iif(len([forms]![frm_Main]![fName] & '')=0,[fName],[forms]![frm_Main]![fName]) والشرح للتأكد بأن الحقل فارغ في النموذج، بدل ان نكتب IsNull([forms]![frm_Main]![fName]) or [forms]![frm_Main]![fName]=0 فإننا نختصر هذين الشرطين بشرط واحد len([forms]![frm_Main]![fName] & '')=0 iif(كان الحقل فارغ في النموذج,[fName] اعطنا جميع بيانات الحقل,[forms]![frm_Main]![fName]واذا كان الحقل به قيمة فاستعمل هذه القيمة) . 3. اذا اردنا البحث عن جزء من الاسم Like IIf(Len([forms]![frm_Main]![fName] & '')=0,"*","*" & [forms]![frm_Main]![fName] & "*") والشرح IIf(Len([forms]![frm_Main]![fName] & '')=0 نعم Like "*" لا Like "*" & [forms]![frm_Main]![fName] & "*") . 4. اذا اردنا البحث بين تاريخين بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null او طريقة استاذنا واخونا العود ابو خليل Between nz([forms]![frm_main]![Date_From];"01/01/1900") And nz([forms]![frm_main]![Date_To];"01/01/2100") . جعفر

تفضل اخي كانت مشكلة في زيادة حجم الملف PhotoC.rar و هذا الثاني PhotoD.rar

يعلم الله اني اتشرف ان اكون تلميذك استاذنا الفاضل @ابوخليل دمتم بكل خير تحياتي

الملف بالمسار الخاص بك Test_21.xls

بعد إذن أستاذنا الفاضل سليم لإثراء الموضوع جرب هذا عن طريق تكست بوكس البحث.xlsm

تفضل ..... مثال.rar

يمكنك استعمال هذا الماكرو البسيط انسخه الى مديول واربططه بزر في شيت sadol1 Option Explicit Sub test() Dim SD1 As Worksheet Dim SD2 As Worksheet Dim lr1, lr2, lr3, lr4 Application.ScreenUpdating = False Set SD1 = Sheets("sadok1") Set SD2 = Sheets("sadok2") lr1 = SD1.Cells(Rows.Count, "b").End(3).Row lr2 = SD1.Cells(Rows.Count, "s").End(3).Row SD1.Range("b8:o" & lr1).Copy lr3 = SD2.Cells(Rows.Count, "b").End(3).Row + 1 SD2.Range("b" & lr3).PasteSpecial SD1.Range("s8:af" & lr2).Copy lr4 = SD2.Cells(Rows.Count, "s").End(3).Row + 1 SD2.Range("s" & lr4).PasteSpecial Application.CutCopyMode = False SD1.Range("b8:o10000").ClearContents SD1.Range("s8:af10000").ClearContents Application.ScreenUpdating = True End Sub

اتفضل أخي PhotoD.rar

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

السلام عليكم اخي الكود المرفق يوضع في الصفحة وهو يقوم بتصفير الخلايا c1.c2.c3 عند تغيير قيمه الخليه A2 وبامكان التعديل عليه حسب الرغبه تحياتي لك كود مسح محتويات الخلايا.zip

شاهد الرابط

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

شكراً استاذى @Abu Farid ملف PhotoD يعمل ولكن يذهب الى السجل الاول اولا جزاك الله خيراً

اذا كنت قد فهمت عليك ماذا تريد اليك هذا الحل For_Dev.xlsx

السلام عليكم مشاركه مع اخى علاء ونرجو منك فضلا لا امرا ان ترفق مثالا لما تطلب ارفق لك مثال لاخ عزيز جزاه الله خيرا وجميع اخوانى واساتذتى الافاضل تقبل تحياتى وتمنياتى لكم وللجميع بالتوفيق رسالة بالتكرار ويعطي الاسم المتكررR.rar

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

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

اضافة تفصيلات بالتاريخ والنوع للتقرير salloum0777134668.accdb

بالاضافة الى ما تفضل به الاخوة الكرام ولهم الشكر من فضلك اخي الكريم @حلبي جرب معي الكود التالي يعمل بطريقة افضل من الاول Option Compare Database Private Sub Command1_Click() ' الشهر الحالي Dim X1, X2 As String X1 = Format(DateSerial(Year(Date), Month(Date), 1), "mm/dd/yyyy") X2 = Format(DateSerial(Year(Date), Month(Date) + 1, 0), "mm/dd/yyyy") myCriteria = "([T1].[COURSEDATE] between #" & X1 & "# and #" & X2 & "#)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub Private Sub Command2_Click() ' الشهر السابق Dim X3, X4 As String X3 = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm/dd/yyyy") X4 = Format(DateSerial(Year(Date), Month(Date), 0), "mm/dd/yyyy") myCriteria = "([T1].[COURSEDATE] between #" & X3 & "# and #" & X4 & "#)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub FILTER.rar تحياتي

تفضل اخي الكريم PhotoC.rar تحياتي

مجهود رائع

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

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

Try this File My_sarch.xlsm

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

السلام عليكم 🙂 الدقة: جميع الاستعلامات لها نفس الدقة في تصفية/فرز البيانات ، السرعة: الاستعلام العادي من خلال معالج الاستعلام كان يمتاز عن بقية انواع الاستعلامات (وهنا لا اتكلم عن Recordset) ، بأن الاكسس كان يعمل له Compile وايضا يعمل له خطة عمل ، مما يجعله اسرع من بقية الانواع ، حيث انه يكون جاهزا للعمل بمجرد فتحه ، اما الآن ، وبوجود الاجهزة الجديدة والسريعة ، فبقية انواع الاستعلام ، تقوم بعمل Compile بسرعة عند استعمالها ، فلا نلاحظ الفرق في سرعة بينهم. ولكن ، هذا كله يعتمد على طريقة عمل الاستعلام ، بغض النظر عن نوعه 🙂 واهم شيء لجعل الاستعلام يعمل بسرعة هو ، عمل فهرسة (في الجداول) للحقول التي بها معايير ، او الحقول التي بها ربط بين الجداول. جعفر

انظر المرفق ::بالتوفيق:: DB2 (2).rar

مثال علي : النسخ الاحتياطي التصدير الي الاكسيل مع ملاحظة أن الجدول E_List يحوي الجداول و الاستعلامات التي تريد الاختيار بينها للتصدير تغيير روابط الجداول من خلال النموذج مع ملاحظة أن الجدول F_LIST يحوي أسماء الجداوال التي تريد تجديد رابطها 3in1.zip

السلام عليكم شكرا لأخي الكريم egyptian_eg وأود بعد أذنه أن أنوه إلى ملحوظة مهمة جدا وهي : إن دالة Int قد تعطي نتائج لا يرغبها من لا يلم بنتائجها للقيم السالبة والأفضل أن تستخدم دالة Fix بدلا منها . نعم دالة Int في بعض اللغات الأخرى تعطي نتائج الـ Fix ولكنها هنا تحتاج إلى التدقيق بمخرجاتها ومقارنتها مع دالة Fix للتعرف على الفرق بينهما في القيم السالبة . تحياتي .

بفرض أن حقل التاريخ الأول a والحقل التاني b ضع هذا الكود فى زر If IsNull([a]) Or IsNull([b]) Then MsgBox "يجب أن تدخل التاريخين الافتتاحي والختامي.", vbCritical, " ادخال خاطئ" DoCmd.GoToControl "a" Else If [a] > [b] Then MsgBox "يجب أن يكون التاريخ الختامي أكبر من التاريخ الافتتاحي.", vbCritical, " ادخال خاطئ" DoCmd.GoToControl "a" Else Me.Visible = False End If End If أشرف خليل

قم يتصميم استعلام الاحاق بالطريقة العادية http://www.officena.net/ib/index.php?showtopic=605 افتح الاستعلام فى وضع ال sql انسخ الكود ضعه فى سطر واحد بين "" مع حذف ما قد يضاف من "" آليا اسبق ذلك بالامر Docmd.runsql مثال INSERT INTO DIALER ( Name, MOBILE ) SELECT DIALER.Name, DIALER.MOBILE FROM DIALER WHERE (((DIALER.Name)="mmmmm") AND ((DIALER.MOBILE)="0101010")); يتحول الي DoCmd.RunSQL "INSERT INTO DIALER ( Name, MOBILE )SELECT DIALER.Name, DIALER.MOBILE FROM DIALER WHERE (((DIALER.Name)='mmmmm') AND ((DIALER.MOBILE)='0101010'));" أو DoCmd.RunSQL "INSERT INTO DIALER ( Name, MOBILE )SELECT DIALER.Name, DIALER.MOBILE FROM DIALER" & _ "WHERE (((DIALER.Name)='mmmmm') AND ((DIALER.MOBILE)='0101010'));" لاحظ أن ال "," لما أصبحت داخل ال "," الخارجية تستبدل ب ' , ' و للكتابة فى سطر جديد ننهي الجملة ب " و نتبعها ب & ثم _ موضوع مرتبط ما هي أقصر الطرق لكتابة جمل ال SQL داخل الكود إدراج جمل SQL داخل ال VBA http://www.officena.net/ib/index.php?showtopic=50 و http://www.officena.net/ib/index.php?showtopic=954

وعليكم السلام ورحمة الله وبركاته أخي/ moayad ليس لدى علم بوجود طريقة حسب ما ذكرت :$ ، ولكن يوجد لدى مثال لقاعدة بيانات تستطيع أن تضغط وتصلح وتنسخ قاعدة أخرى ، أضف إلى أنها تستطيع أن تقوم بعمل ذلك لعدة قواعد أخرى في وقت واحد تقع في مسارات مختلفة. وأعتقد أنك لو أنشئت إختصار للمثال المذكور على سطح المكتب لأستطعت أن تضغط وتأخذ نسخة إحتياطية من أي قاعدة :pp: . جرب وأخبرني أن كانت مفيده والمثال مرفق والله الموفق. Compact_Backup.rar

طبق الكود السابق هكذا On Error GoTo errsub DoCmd.Hourglass True DBEngine.CompactDatabase datapath, Backuppath, DB_LANG_ARABIC DoCmd.Hourglass False errsub: If Err.Number = 3204 Then MsgBox " A database with the same name exists in the same location ! ", 64, "Duplicate Backup Name" ElseIf Err.Number = 3356 Then MsgBox "Another user is Currently using the Database" + Chr(10) + Chr(13) + "Wait Until No Other Users are Using the Database !", 16, " Other Users WArning Message " ElseIf Err.Number = 3024 Then m = " The Database Source File : " + datapath + Chr(10) + Chr(13) + " is not available !" + Chr(10) + Chr(13) + "Please check the Source Database Name and Location" MsgBox m, 16, "Missing Data Table " ElseIf Err.Number = 3044 Then m = " Invalid File Name : " + Chr(10) + Chr(13) + "Please check the File name and location " MsgBox m, 64, "Invalid File Name " ElseIf Err.Number = 20477 Then m = " Invalid File Name : " + m3 + Chr(10) + Chr(13) + " OR " + m4 + Chr(10) + Chr(13) + " is not available !" + Chr(10) + Chr(13) + "Please check the Source Database Name and Location" MsgBox m, 64, "Invalid File Name " Else MsgBox Str(Err.Number) + Err.Description End If MsgBox "Action Canceled ! " DoCmd.Hourglass False فى زر اغلاق التطبيق

مثال آخر على النسخ الاحتياطي CopyDB2000.zip