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

جرب هذا الماكرو Option Explicit Dim LC%, LD%, LM%, k%, i%, m% Dim last_col%, Tar_col% Dim RC As Range, RD As Range, RM As Range Dim R_date As Range, Fd1 As Range Dim Date1 As Date, Date2 As Date Dim Max_date As Date Dim Min_date As Date '+++++++++++++++++++++++++++++++++++ Sub General_Macro() Set R_date = Cap.Range("E4").Resize(, 100) last_col = Cap.Cells(4, Columns.Count).End(1).Column If last_col < 6 Then Exit Sub Min_date = 100000: Max_date = 1 For i = 6 To last_col If Cap.Cells(4, i) > Max_date Then Max_date = Cap.Cells(4, i) End If If Cap.Cells(4, i) < Min_date Then Min_date = Cap.Cells(4, i) End If Next Set RC = Cap.Range("A6").CurrentRegion LC = RC.Rows.Count Set RD = Daay.Range("A6").CurrentRegion LD = RD.Rows.Count Set RM = More.Range("A6").CurrentRegion LM = RM.Rows.Count End Sub '+++++++++++++++++++++++++++++++++++++ Sub One_day() General_Macro If last_col < 6 Then Exit Sub If Daay.Range("A6") <> "" Then Daay.Range("A6"). _ Resize(LD + 1, 6).ClearContents End If If Not IsDate(Daay.Range("b2")) Or _ Daay.Range("B2") < Min_date Or _ Daay.Range("B2") > Max_date Then Date1 = Min_date Daay.Range("B2") = Date1 End If Date1 = Daay.Range("B2") m = 6 Set Fd1 = R_date.Find(Date1, lookat:=1) If Not Fd1 Is Nothing Then Daay.Cells(4, 6) = Date1 Tar_col = Fd1.Column For k = 6 To LC + 5 If Cap.Cells(k, Tar_col) <> "" Then Daay.Cells(m, 1).Resize(, 5).Value = _ Cap.Cells(k, 1).Resize(, 5).Value Daay.Cells(m, 6) = Cap.Cells(k, Tar_col) m = m + 1 End If Next End If End Sub '+++++++++++++++++++++++++++++++++++++++ Sub More_days() General_Macro Dim X%, Periode% If last_col < 6 Then Exit Sub If More.Range("A6") <> "" Then More.Range("A6"). _ Resize(LM + 1, 6).ClearContents End If More.Cells(4, "F").Resize(, 100).ClearContents If Not IsDate(More.Range("B2")) Or _ More.Range("B2") < Min_date Or _ More.Range("B2") > Max_date Then Date1 = Min_date More.Range("B2") = Date1 End If Date1 = More.Range("D2") If Not IsDate(More.Range("D2")) Or _ More.Range("D2") < Min_date Or _ More.Range("D2") > Max_date Then Date2 = Max_date More.Range("D2") = Date2 End If Date1 = Application.Min(More.Range("B2,D2")) Date2 = Application.Max(More.Range("B2,D2")) More.Range("B2") = Date1 More.Range("D2") = Date2 Periode = Date2 - Date1 + 1 With More.Cells(4, "F") For i = 1 To Periode .Offset(, i - 1) = Date1 + i - 1 Next End With m = 6 Set Fd1 = R_date.Find(Date1, lookat:=1) If Not Fd1 Is Nothing Then Tar_col = Fd1.Column For k = 6 To LC + 5 X = Application.CountA(Cap.Cells(k, Tar_col) _ .Resize(, Periode)) If X > 0 Then More.Cells(m, 1).Resize(, 5).Value = _ Cap.Cells(k, 1).Resize(, 5).Value More.Cells(m, 6).Resize(, Periode).Value = _ Cap.Cells(k, Tar_col).Resize(, Periode).Value m = m + 1 End If Next k End If End Sub الملف مرفق Kara3_21.xlsm

يوجد مثال في المنتدى يفي بالغرض، فغط صمم تقرير جديد و اجعل مصدره الاستعلام مثل المثال المرفق و سوف يظهر لك السطور الجديدة التي تريد معرفتها في حالة وجودها أما اذا كانت غير موجودة فلن يطبع التقرير كود عدم تكرار طباعة تقرير معين.rar

وعليكم السلام 🙂 انا اعرف انك ما تريد هذه الحلول ، ولكني اضعها هنا علشان اللي يرد يعرف انك ما تريد رد مثلها : استعلام عن طريق VBA - قسم الأكسيس Access - أوفيسنا (officena.net) جعفر

السلام عليكم، لو اردنا ان نقوم بحفظ السجلات المحددة في النموذج الفرعي سنلجئ لعمل CheckBox في الجدول ومن ثم نقوم بعمل استعلام يقوم بفلترة جميع الـ Checkbox التي تكون قيمتها True ومن ثم نقوم بحفظها. لكن! ماذا لو كانت قاعدة البيانات تعمل بنظام الشبكة ( Multi Users ) اذا قام المستخدم رقم 1 بوضع علامة صح على مثلا مادة ( برتقال ) وقام المستخدم رقم 2 بوضع علامة صح على مثلا مادة ( رمان ) عندما يضغط اي مستخدم على حفظ البيانات فـ ستحفظ البيانات وتكون النتيجة خاطئة لان البيانات ليست هي المطلوبة انا اخترت ( برتقال ) فأتتني النتيجة ( برتقال + رمان ) وكذا بالنسبة للمستخدم الثاني والثالث وغيرهم، ممن يعملون على قاعدة البيانات بوقت واحد، صراحة واجهتني هالمشكلة لكن وجدت الحل لها كما انني رأيت موضوع للأخ ابا جودي يتكلم عن هذه المشكلة ارفقت لكم طريقة مختلفة في تحديد السجلات وهي الضغط على مُحدد السجلات للأمانة الطريقة ليست كلها من برمجتي الحقوق لـ arnelgp انا فقط قم اضافة وتعديل بعض الامور البسيطة تحياتي لكم RecordSelectorClick.accdb

وعليكم السلام اخوي ابو احمد 🙂 بالنسبة لفتح نافذة الوندوز إختيار الملفات ، فهناك طريقة اخرى لا تحتاج الى الكود اعلاه Windows API ، وتجده هنا مثلا: https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=189174 ولكن اذا اردت النظر في الكود الذي ارفقه انت ، فهذه الاسطر من الكود لا تكفي للنظر في المشكلة ، فأنا محتاج الى مثال يعمل ، علشان اضبطه للنواتين 32 و 64بت 🙂 جعفر

في الملف الأخير تم تعديل الماكرو ليمسح البيانات القديمة (أعد تجميله) "Kara3_22.xlsm"

ما هو الموجود في الشيت "قائمة الزبائن" 5 زبائن فقط حاول اضافة زبائن اخرى و ترى النتائج كما في هذا الملف Kara3_22.xlsm

تمام بارك الله فيك

لو ارفقت ملفا لقمنا بادراج الكود به ملف به كودان ورقة1 اصغظ الزر ورقة 2 كود في حدث الصفحة تذييل.xlsb

اضف هذا السطر في الكود كما في الصورة ws2.Range("a6:d1000").Interior.Color = xlNone الصورة

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

تفضل وبما انك لم تقم ايضاً برفع الملف فسأرد أيضاً بدون ملف أو تفضل هذا الرابط https://pdfcandle.com/ar/word_excel.aspx

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

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

بانسبة للطباعة انسخ هذا الكود الى مديول واربطه مع زر جديد في شيت الطباعة Option Explicit Sub printDOC() Dim LR LR = Cells(Rows.Count, 2).End(3).Row If MsgBox("هل تريد طباعة التقرير", vbExclamation + vbYesNo) = vbYes Then Range("a1:d" & LR).PrintPreview End If End Sub

Option Explicit Sub test() Dim lr, c, x, r, lr2 Dim ws As Worksheet Set ws = Sheets("DATA") Dim ws2 As Worksheet Set ws2 = Sheets("الطباعة") c = ws.[d3] r = 6 Application.ScreenUpdating = False With ws ws2.Range("a6:d1000").ClearContents ws2.Range("a6:d1000").Borders.LineStyle = 0 lr = .Cells(Rows.Count, 1).End(3).Row For x = 6 To lr Select Case .Cells(x, 1).Value2: Case c ws2.Range("b4").Value = .Cells(x, 1).Value ws2.Range("a" & r).Value = .Cells(x, "e").Value ws2.Range("a" & r).Offset(, 1).Value = .Cells(x, "d").Value ws2.Range("a" & r).Offset(, 2).Value = .Cells(x, "b").Value ws2.Range("a" & r).Offset(, 3).Value = .Cells(x, "c").Value ws2.Range("a" & r).Resize(, 4).Borders.LineStyle = xlDot r = r + 1 End Select Next x lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 2 ws2.Range("b" & lr2) = "اجمالي" ws2.Range("c" & lr2) = WorksheetFunction.Sum(ws2.Range("c6:c" & r - 1)) ws2.Range("d" & lr2) = WorksheetFunction.Sum(ws2.Range("d6:d" & r - 1)) If ws2.Range("c" & lr2) > ws2.Range("d" & lr2) Then ws2.Range("b" & lr2).Offset(1) = "اجمالي مدين" ws2.Range("c" & lr2).Offset(1) = ws2.Range("c" & lr2) - ws2.Range("d" & lr2) ElseIf ws2.Range("c" & lr2) < ws2.Range("d" & lr2) Then ws2.Range("b" & lr2).Offset(1) = "اجمالي دائن" ws2.Range("c" & lr2).Offset(1) = ws2.Range("d" & lr2) - ws2.Range("c" & lr2) End If '==================== ws2.Range("a" & lr2).Resize(1, 4).Interior.Color = 49407 ws2.Range("a" & lr2 + 1).Resize(1, 4).Interior.ThemeColor = xlThemeColorAccent5 With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin End With With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeBottom) .LineStyle = xlDot .Weight = xlThin End With With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeRight) .LineStyle = xlDot .Weight = xlThin End With With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeLeft) .LineStyle = xlDot .Weight = xlThin End With With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeTop) .LineStyle = xlDot .Weight = xlThin End With '====================== ws2.Activate End With Application.ScreenUpdating = True End Sub

همممم انا الآن جربت جميع روابط الصفحة الاولى ، وجميعها شغال ويتم انزال المرفق !! جعفر

لا أعلم هذا كنت نريد هذا الشيء معادلة لادراج فائمة منسدلة متحركة في الخلية E2 Harb.xlsx

تم بفضل حل المشكل شكرا لكل من حاولة في حله كما أريد أن أرى حلول أخرى Nouveau Microsoft Access Base de données.rar

سؤالك بدون ملف . وطلبك عير واضح على الاقل بالنسبة لي اذا كان طلبك ادراج قيمة خلية من صفجة وادراجها في تذييل الصفحة فيمكنك استخذام هذا الكود Sub FooterFrom_P1() With ActiveSheet.PageSetup .RightFooter = "&14&""Arial,Bold""" & Range("a1").Value End With End Sub شرح الكود RightFooter تذييل يمين 14 حجه الخط Arial,Bold نوع الخط Range("a1").Value قيمة الخلية من الصفجة ويمكنك التعديل في الكود اذا كان التذييل يسار او وسط هذا حسب فهمى لسؤالك وان غير ذلك ارفق ملفا حفظك الله ورعاك

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

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

بعد اذن الاخ على =INDEX($B$10:$B$39,MATCH(0,$B$10:$B$39,0)-1)

فقط يمكنك استخدام معادلة المصفوفة (Ctrl+Shift+Enter) =OFFSET($B$10,MAX(ROW(B:B)*(B:B<>0))-10,0) Sheets1.xlsx

طلبك ليس بالسهل او الهين فعليك بالتحلى بالصبر ويكفيك كتابة كلمة للـــــرفع وغير مسموح بكتابة غير ذلك فعليك بالإطلاع على قواعد وقوانين الإشترك بالمنتدى قواعد المشاركة بمنتدي أوفيسنا

بنسخة 365 أى بمقابل مادى

وعليكم السلام ورحمة الله وبركاته في كود استعراض وفتح قاعدة البيانات اضف الامتداد للفلتر strFilter = ahtAddFilterItem(strFilter, "Access files (*.accdb, *.mdb)", "*.accde;*.mde") او يمكنك عند استعراض قاعدة البيانات كتابة *.* لعرض جميع الملفات في المجلد تحياتي

وعليكم السلام 🙂 وبدون الرجوع الى المرفق : dim myWhere as string myWhere="[pc]='" & [Text0] & "'" myWhere=myWhere & " And [StartDate]=#" & [StartDate] & "#" myWhere=myWhere & " And [txt]='" & [Text2] & "'" DoCmd.OpenForm "Table1", acNormal, myWhere , acReadOnly, acNormal البساطة مافي احسن منها ، كل جملة بنفسها وبدون اخطاء 🙂 جعفر

وعليكم السلام 🙂 جرب نفس النموذج الان ، والتفاصيل لما ارجع ان شاء الله 🙂 جعفر bb - Copy.zip

وعليكم السلام 🙂 ارجو ان يكون هذا قصدك : . والكود عند تحميل النموذج : Private Sub Form_Load() Dim DBDAO As DAO.Database Dim mySQL As String mySQL = "Select * From aa" Set DBDAO = CurrentDb Set Me.Recordset = DBDAO.OpenRecordset(mySQL, dbOpenDynaset) End Sub . والنتيجة : . جعفر bb - Copy.zip

وعليكم السلام ورحمة الله وبركاته يمكنك ذلك من خلال البحث والاستبدال في خانة البحث عن اكتب: (*)(.)(*) وفي خانة استبدال بـ اكتب: \1\2^l\3 ولا تنس تفعيل باستخدام أحرف البدل. بعد ذلك انقر زر استبدال الكل.

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