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

السلام عليكم و رحمة الله و بركاته ماشاء الله عليك يا ابا عبدالله استفدنا كثير من مشاركتك الذهبية و فعلا كود رائع‘ وتحية لاستاذ الغالي ابا خليل الذي هو سبب الغنيمة هذا. و لتغير لون خلفية حقول بدلا من خلفية تفصيل قمت باضافة بسيطة على الكود كما في مرفق. 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

السلام عليكم ورحمة الله وبركاته 🙂 عندما يكون برنامج الاكسس يعمل ، وفجأة بدأ بإعطاء رسائل خطأ وبدون اي تعديل في البرنامج ، او عند عمل تعديل على البرنامج يُغلق الاكسس: . طريقة العمل: سيفتح البرنامج ، ويجب عليك غلقه ، الى ان لا يفتح تلقائيا مرة اخرى. ولكن ، يجب دائما اخذ الاحتياط وعمل نسخة من البرنامج قبل عمل هذه الخطوات. اقدم لكم شرح بسيط عن الموضوع: في الكثير من الاوقات ، لما نعمل الكود ، نقوم بتعديل وتغيير وتضبيط الكود عدة مرات ، ولكن الاكسس في بعض الاحيان يبقى محتفظ بالكود القديم في ذاكرته !! لذلك : 1. اثناء البرمجة ، وبشكل يومي اقوم بتشغيل هذا الملف المرفق ، 2. وقبل تسليم البرنامج الى الزبون ، اقوم بتشغيل الملف للمرة الاخيرة ، واجهز البرنامج لتسليمه الى الزبون وهذا هو الكود المعدل عن النسخة السابقة: Private Sub cmd_Decompile_Click() Dim MSAccPath As String Dim RegKey As String Dim WSHShell 'As Object Dim waitOnReturn As Boolean: waitOnReturn = True ' Get MSACCESS.exe directory from the Registry RegKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\" & _ "CurrentVersion\App Paths\MSACCESS.EXE\Path" Set WSHShell = CreateObject("WScript.Shell") ' Get parent directory MSAccPath = WSHShell.RegRead(RegKey) ' Decompile WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /decompile", , waitOnReturn ' compact WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /compact", , waitOnReturn ' cmd compile WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /cmd compile", , waitOnReturn ' compact WSHShell.Run Chr(34) & MSAccPath & "MSACCESS.EXE" & Chr(34) & " " & Chr(34) & Me.str_File_Single & Chr(34) & " /compact", , waitOnReturn ' Clear shell var Set WSHShell = Nothing End Sub جعفر Decompile_2.zip

يمكنك استعمال هذا الماكرو البسيط انسخه الى مديول واربططه بزر في شيت 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

شاهد الرابط

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

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

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

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

الاستاذ الفاضل / @Abu Farid سؤال لو سمحت لى : هل انت عضو جديد ام خبير الاستشعار عندى يقول شئ تانى اخر . دعنى اتابع ردودك بعد ذلك لكى اتحقق ولو سمحت لو سمحت لا تقول لى انك طالب علم ومازلت تتعلم وانك فى اول الطريق هذه ليست محاولة منك كما قلت بل هو الحل الامثل ، نعم هذا المطلوب كيف هذا ياشيخ روح الله يعمر بيتك ويجزاك كل خير ـ ويرحم والديك دنيا وآخره ويزيدك الله علما ويعافيك في صحتك ومالك ورزقك ـ امين امين واحب ان اشكر استاذنا الفاضل / @محمد ابوعبد الله- واستاذنا / @احمد الفلاحجي واستاذنا / @alaa aboul-ela على ما قدموه لى من مساعدات ويارب يارب يجزاهم الله خير على ما يقدموه لنا كل الاحترام والتقدير لكم جميعا

صديقي.. لا يمكن العمل على صورة و ليس لي اي علم ان صورة تستطيع ان تعالج معادلة من اكسل ريثما تستطيع MicroSoft ان تجعل الصورة تفعل هذا الشي عليك رفع الملف وليس صورة عنه

وهذا ايضا احد محاولات PR1.mdb

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

اخى الفاضل عماد محاوله منى على قد حالى وهى باستخدام نموذج رئيسى مع الفرعى المستمر الرئيسى لادخال البيانات وتظهر فالنموذج المستمر مباشره ولاكن لاتستطيع التعديل على t4 لانه مغلق واعذرنى فمازلت اتعلم معكم تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق PR1.mdb

مجهود رائع

أستاذ محمود محمود احمد أين الضغط على الإعجاب ؟!💙

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

Try this File My_sarch.xlsm

جرب هذا الكود بشرط تحديد نطاق ( خلية أو عدة خلايا ) ومع الأسف لا يمكن معاينة قبل الطباعة عند طباعة التحديد Sub PrintSelection() Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False End Sub

شاهد الرابط

دورة اكسس للمبتدئين تابعوا الشرح على هذا الرابط

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

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

السلام عليكم أساتذتى واخوانى بالمنتدى تناولت فى موضوعى السابق طريقة نقل بيانات من ملف مغلق الى ملف مغلق أخر بطريقة تسمى ado وهى اختصار للعبارة ActiveX Data Objects بدأ العمل بها فى مايكروسوفت 1996 تستخدم هذة الطريقة فى ترحيل ونقل البيانات بين الملفات استخدمت هذه الطريقة فى جلب البيانات الى شيت رئيسى ثم ربطت الشيت الرئيسى بشيت آخر بلينك . بعد ذلك قلت لنفسى لو عندى كود لادخال البيانات الى ملف مغلق يبقى الأمر 10/ 10 ثم بحث عن كود ووجدت واحد فى أحد المواقع الأجنبية وقمت بتعديله بطريقة لا يشعر فيها المستخدم بأن الملف ده اتفتح والتفاصيل هنا : http://www.officena.net/ib/index.php?showtopic=57798 والحمد لله تم استبدال اللينك بكود . وتركت لكم الملفات فى الرابط ده . مرة مستخدما اللينك ومرة الكود فى ادخال البيانات للملف المغلق . و اليوم أقدم لكم كيفية جلب البيانات من 3 ملفات مغلقة دفعة واحدة وبضغطة زر واحدة ومن ثم ترحيلها وادخالها الى ملف مغلق آخر دون شعور المستخدم بذلك وهذا يتم بذات الطريقة السابقة . للأصدقاء من خارج المنتدى : على الميديا فاير من خلال الرابط التالى http://www.mediafire.com/download/gidslzjdssb2jii/copy__data_from_a_closed_excel_file__&_paste_it_in_a_closed_excel_file_by_mokhtar_(__3_).rar للأصدقاء فى المنتدى : تفضلوا الملفات فى المرفق التالى . أرجوا أن يفيدكم وتستمتعوا به تحياتى للجميع copy data from 3 closed excel file & paste it in a closed excel file by mokhtar ( 3 ).rar

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

بفرض أن حقل التاريخ الأول 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

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