Leaderboard
Popular Content
Showing content with the highest reputation since 01/28/2021 in all areas
-
أما عن مشاركتي.. استخدمت أدوات ActiveX لأنها قابلة للإستنساخ (التوريث).. عند الضغط على زر الفارة الأيسر يقوم الحدث باستنساخ إداة العنوان ووضعها في موقع النقر تتضمن رقماً يمثل رقماً افتراصيا للأرض المعروضة للبيع.. بعد ذلك يقوم الحدث بتسجيل المعطيات في جدول البيانات (رقم الأرض الافتراضي، موقع أداة العنوان،..) الأدوات المستنسخة صورية لاتحفظ داخل النموذج.. ويتم محوها عند إغلاق النموذج! لكن يعاد استنساخ هذه الأدوات عند إعادة فتح النموذج بناءً على المعطيات التي سبق حفظها في الجدول.. Map Pointer.zip9 points
-
مبروك الأستاذ محي الدين ابو البشر إنضمامك لعائلة الخبراء ,أسأل الله لك التوفيق والنجاح دائما ..وأعانك الله على هذه المسئولية الجديدة وسدد الله خطاك عن حق وجدارة بارك الله فيك وزادك الله من فضله8 points
-
بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته في هذا الدرس سأقدم نظرة عامة، ومُقدمة على التعابير القياسية Regular Expression وذلك لأهميتها الكبيرة في البرمجة. ملاحظة: لن اتطرق لكيفية كتابة الـ patterns نضرة لصعوبته على البعض لانه يحتاج اساسيات ومقدمات. في هذا الدرس سوف أستخدم بإذن الله لغة VBA في عمل اختبارات على الـ Regular Expression تعريف Regular Expression: هو كائن يصف نمطًا من المحارف ( أو الكلمات ). تعريف أعمق للتعابير القياسية: هي سلسلة من الأحرف التي تحدد نمطًا للبحث داخل النصوص (String) أو للمطابقة بين سلاسل من الأحرف. الهدف من ا7 points
-
جرب هذا الكود Option Explicit Sub All_in_One() Dim Ob As Object Dim Lr, i Dim Sd#, Se#, Sf#, Sg#, _ Sh#, Si#, Sj#, Sk# Dim kY Dim Sal As Worksheet Set Sal = Sheets("Salim") Lr = Sal.Cells(Rows.Count, 1).End(3).Row Sal.Range("P2").Resize(Lr, 12).ClearContents Set Ob = CreateObject("Scripting.Dictionary") With Sal For i = 2 To Lr Sd = Sd + Val(.Cells(i, "D")): Se = Se + Val(.Cells(i, "E")) Sf = Sf + Val(.Cells(i, "F")): Sg = Sg + Val(.Cells(i, "G")) Sh = Sh + Val(.Cells(i, "H")): Si = Si + Val(.Cells(i, "I")) Sj = Sj + Val(.Cells(i, "J")): Sk = Sk + Val(.Cells(i, "K")) Ob(.Cel6 points
-
5 points
-
السلام عليكم 🙂 اذا عملنا برنامج على الاكسس 32بت ، وفيه مكتبات الوندوز الـ 32بت (لاحظ الرقم 32 في اسم المكتبة: comdlg32.dll) ، فنحصل على هذا الخطأ : . يوجد ملف في موقع مايكروسوف (مرفق نسخة Win32API_PtrSafe.zip) ، وفيه طريقة عمل مناداة النواتين : https://www.microsoft.com/en-us/download/details.aspx?id=9970 وتوجد مواقع مجهزة الكود للنواتين ، مثل (فقط ابحث عن الدالة ، واعمل نسخ/لصق للكود) : http://www.jkp-ads.com/articles/apideclarations.asp -------------------------------------------------------------------------------------------------------------5 points
-
وعليكم السلام-عليك بإستخدام هذا الكود Sub run() Range("a65536").End(xlUp).Select End Sub الذهاب الى اخر صف مكتوب.xlsm5 points
-
وعليكم السلام-يمكنك استخدام هذه المعادلة =COUNTIF(A3:AC3,"ح")+COUNTIF(A3:AC3,"ج")+COUNTIF(A3:AC3,"ق") مجموع الأحرف1.xlsm5 points
-
تفضل يمكنك استخدام هذه المعادلة لطلبك =IF($E52="","",IF(AND($D52>$H52,$H52<>0),"سداد جزئى",IF($D52=$H52,"سداد كلى",0))) مثال1.xlsx5 points
-
السلام عليكم و رحمة الله و بركاته لدى تصفحي أحد المواقع وجدت هذا المثال فأحببت ان أقوم بمشاركته , / بعد تعريبه طبعآ / عله يستفيد منه أحد الاخوة ثيمات.mdb5 points
-
لن يطول انتظارك بإذن الله.. في الواقع قد رتبت لهذا من قبل! ولم يمنعني من رفعه دفعة واحدة إلا التشويق! وأن يرى الزملاء الأشياء الجديدة على مهل.. Map Pointer.zip5 points
-
تفضل يمكنك هذا بهذه المعادلة =IFERROR(INDEX(البيانات!$C$2:$F$11,MATCH($B2,البيانات!$B$2:$B$11,0),MATCH(C$1,البيانات!$C$1:$F$1,0)),"") تقرير1.xlsx5 points
-
السلام عليكم ورحمة الله تعالى وبركاته اخوانى الكرام منذ ان بدأت هذا المشروع ولم افكر لحظة فى ان احيد عنه الان اقدم لكم مكتبة جديدة متلافيا فيها بعض المشاكل التي قابلتنا قديما وادرجت بها دوال جاهزة وسهلة المكتبة بها اداة listview وبها ثلاث دوال الدالة الاولي ListFolder(ByVal FolderPath As String) وهى دالة لعرض الملفات فى مجلد معين حيث FolderPath هو مسار المجلد ويتم استدعااء الدوال بهذا الكود Option Explicit Option Compare Database Public listv As MsAccessListviewACX1_00.UCBySedo Private Sub Command115_Click() Set listv = Me.U5 points
-
أهلابك.. نعم يمكن.. انسخ السطر المتعلق بالزر والذي أشرت إليه أعلا وسوف يأخذ نفس الخصائص Dashboard2003.mdb5 points
-
بعد اذن الأستاذ حسين ولإثراء الموضوع يمكنك هذا بهذه المعادلة =IFERROR(IF(B2="عام",VLOOKUP($E2&"/"&$D2,الحالة!$N$2:$Q$80,2,0),VLOOKUP($E2&"/"&$D2,الحالة!$H$2:$K$80,2,0)),"") المنتوج+المحور+الاستحقاق1.xlsx5 points
-
جرب هذا الماكرو ( لا صفوف فارغة في الجداول لان الماكرو يتوقف عند أول حلية فارغة) Option Explicit Sub All_in_One() Dim First As Worksheet Dim arr(1), Sh, i% Dim dic As Object Set First = Sheets("Sheet1") Set dic = CreateObject("Scripting.Dictionary") arr(0) = "Sheet2": arr(1) = "Sheet3" First.Range("B1").CurrentRegion.ClearContents For Each Sh In arr i = 3 Do Until Sheets(Sh).Range("B" & i) = vbNullString dic(Sheets(Sh).Range("B" & i).Value) = vbNullString i = i + 1 Loop Next Sh If dic.Count Then First.Range("B2") = "Names" First.Range("B3")5 points
-
بداية يجب إرجاع الفضل لإهله الاستاذ / سليم حاصبيا - الاستاذ ابراهيم الحداد فى مساعدتهم الدائمة وخاصة فى اعداد هذا البرنامج والذى اتمنى ان يحوز رضاكم كتلميذ من تلامذة المنتدى أمنيتى تعريفى بعيوبه من جانب اساتذتى واسم المستخدم/ محمد فتحى / وكلمة المرور 1970 ومحرر الاكواد / 6101970 1562309003_.rar4 points
-
وعليكم السلام-يمكنك استخدام هذه المعادلة =IFERROR($G3*VLOOKUP($A3,'نسب العمولة'!$D$3:$G$800,2,0),"") Test1.xlsx4 points
-
Dim rst As Recordset Set rst = Me.RecordsetClone rst.MoveFirst Do Until rst.EOF If rst![رقم العملية] = Me![T4] Then MsgBox " السجل مكرر ", , " تنبيه" Me.Undo DoCmd.CancelEvent Exit Do End If rst.MoveNext Loop rst.Close F05.rar4 points
-
{ السلام عليكم ورحمة الله وبركته } كيف حالكم ان شاله بخير اليوم حبيت اشاركم كود او ملف راح يفيد مستخدمين اكسس بشكل كبير الملف المرفق في هذا الموضوع فيه ملف تجريبي هو عباره عن ملف يتم وضعه بجوار البرنامج ويحمل نفس اسم البرنامج وعند عمل اختصار لفتح البرنامج قم بوضع الاختصار علي الملف الذي وضعته بجوار البرنامج محتوا الملف كود وكل ما عليك فعله وها فتح الملف من خلال تحريره وفي مكان المخطط في الأصفر ضع اسم البرنامج مع صيغته كما موضح في الصورة بعدها اعمل اختصار لفتح هذا الملف وها بدورة راح يفتحك برنامج ولاكن بدون تشغيل خلفية اكسس وأيضا اذا كان الأمان شغال راح4 points
-
أحسنت أستاذ محمد عمل ممتاز بارك الله فيك وجعله الله فى ميزان حسناتك4 points
-
وعليكم السلام-بعد اذن الأستاذ سليم ولإثراء الموضوع ,تفضل تم عمل معادلة مصفوفة لطلبك (Ctrl+Shift+Enter) ... كما تم عمل قائمة منسدلة بالخلية B1 لتسهيل العمل لك لإختيار بدلاً من الكتابة لتقليل الأخطاء =IFERROR(INDEX(رئيسية!$B$2:$B$140,SMALL(IF(رئيسية!$C$2:$C$140=$B$1,ROW(A$2:A$140)-ROW(A$2)+1),ROWS($A$3:A3))),"") GOING1.xlsx4 points
-
وعليكم السلام يمكنك استخدام هذه المعادلة-معادلة مصفوفة (Ctrl+Shift+Enter) IF(AND(A$19<>$A$1:$U$1,A$19<>$A$9:$U$9),"غير موجود",IFERROR(HLOOKUP(A$19,$A$1:$U$3,2,0),HLOOKUP(A$19,$A$9:$U$11,2,0))) دمج1.xlsx4 points
-
أكسس ليس بحاجة إلى أن تزعي عنه الأمان أو تخفضيه! أكسس بحاجة إلى أن تمنحيه مكاناً آمن ليعمل منه بحرية! أكسسي منحته الحرية الكاملة للعمل من أي مكان على حاسبي بهذه الطريقة..4 points
-
وعليكم السلام-حاول إضافة هذا السطر بالكود بعد السطر الذى تحدث به المشكلة Sheets("Sheet1").Protect UserInterfaceOnly:=True جلب الاسماء من عدة شيتات مع عدم التكرار1.xlsm4 points
-
وعليكم السلام-بكل بساطة يمكنك استخدام هذه المعادلة لطلبك وزيادة عن ذلك تم عمل قائمة منسدلة لأسماء الطلاب لتسهيل الإختيار بدل من الكتابة =IFERROR(VLOOKUP($D4,ورقة1!$D$4:$F$600,3,0),"") 1استدعاء.xlsx4 points
-
السلام عليكم وذلك من خلال هذه المعادلة بداية من الخلية P2 =IFERROR(INDEX($A$2:$A$550,AGGREGATE(15,6,ROW($A$1:$A$302)/(MATCH($A$2:$A$550&$B$2:$B$550&$C$2:$C$550,$A$2:$A$550&$B$2:$B$550&$C$2:$C$550,0)=ROW($A$1:$A$302)),ROWS($2:2))),"") Book2.xlsx4 points
-
مرحبا استاذنا الفاضل حسين هذا المثال خطير جدا ويحتوي على ثغرة الاستعلامات البنيوية ويمكن بسهولة اختراق كلمة المرور وايضا يمكن حقن القاعدة باستعلام يدمر العنصر الاهم في القاعدة (الجداول) وقد سبق مناقشتة باستفاضة بمشاركة الاستاذ الفاضل @rey360 ومعلمنا الفاضل @jjafferr تحياتي وتقديري4 points
-
زيادة في الموضوع 1- عند الضغط على اي سطر في الليست بوكس (ما عدا سطر العنوان طبعاً) تظهر لك بيانات الاسم في التكست بوكسات Shibl_Extra.xlsm4 points
-
بعد اذن اخي حسام انت بحاجة لمثل هذا Dim rs1 As DAO.Recordset: Dim rs2 As DAO.Recordset Set rs1 = CurrentDb.OpenRecordset("SELECT ........")'استعلام يظهر المراقب الأول حسب اليوم Set rs2 = CurrentDb.OpenRecordset("SELECT ........")'استعلام يظهر المراقب الثاني حسب اليوم rs1.Edit: rs1!tech_code = المراقب الثاني rs2.Edit: rs2!tech_code = المراقب الأول rs1.Update: rs2.Update لاحظ انه غالبا يصعب تمرير المعايير لنموذج غير منضم داخل الاستعلام ، لذا نلجأ الى انشاء وحدات نمطية عامة كوسيط tabdeel2.rar4 points
-
4 points
-
يسرني ويسعدني أن أضع بين يديكم برنامج التدريب الالكتروني قمت بتصميمه من الصفر أخذ مني جهد ووقت كبير . استفدت من خبراء هذا المنتدى المبارك. لي طلب أن تدعو لوالدي وجميع مرضى المسلمين والمسلمات بالشفاء العاجل. هذا المشروع أضعه صدقة جارية لكل طالب علم ، و كل مشارك في هذا المنتدى . أسأل الله أن يتقبل منا ومنكم صالح الأعمال . ولا تنسونا من دعواتكم الصادقة في ظهر الغيب . اترك البرنامج لكم لتكتشفوا أسراره 😄 اضف مرفقات موجوده ProTraining20.zip4 points
-
وعليكم السلام-يمكنك استخدام هذه المعادلة لطلبك =EDATE($C5,$D5*12-$E5) test1.xlsx4 points
-
اضافة لما اشار اليه استاذي الفاضل جعفر اود ان اشير الى ان الاشكاليه كانت في النسخ الاولى للاصدار 2007 وتم حلها بعد ذلك مع ذلك هناك اربع خطوات اشارت اليها مايكروسوفت فيما يتعلق بعملية الضغط والاصلاح بعنوان قبل البدء نفذ الإجراءات التالية قبل بدء عمليه الضغط والإصلاح: إنشاء نسخه احتياطيه لقاعده البيانات فأثناء عملية الإصلاح، قد يقتطع Access بعض البيانات من الجداول التالفة. وفي بعض الأحيان يكون من الممكن استعادة هذه البيانات من النسخة الاحتياطية. بالاضافه إلى استراتيجية النسخ الاحتياطي العادية ، يجب إنشاء نسخه احتياطيه علي الفور قبل استخدام الأمر " ضغط قاعده البيانات وإصلاح4 points
-
اخبرني احد الأخوة أن المرفق لا يعمل ويبدو وكانه فيرس سأقوم بتحميل المرفق بصيغة accdb أشكر أخوتي أ/ @kanory و أ/ @abouelhassan علي مروهم الكريم وكلماتهم الطيبات ولا انسا تقديم الشكر للأستاذ أحمد عبدالمنعم صاحب هذا الفيديو فقد كان من المصادر الهامة أيضا هذا MenuAndShortCutMenu.accdb4 points
-
السلام عليكم ورحمة الله وبركاته بسم الله والحمدلله والصلاه والسلام على من لا نبى بعده سيدنا وامامنا وقائدنا وشفيعنا محمد صل الله عليه وعلى آله وصحبه وسلم تسليما كثيرا درس اليوم بسيط جدا ومهم وقد اتعبنى هذا الفرق كثيرا الى ان رايت هذا الفيديو واردت مشاركتكم المعلومه للاستفاده والاستذاده من اخوانى واساتذتى جزاهم الله عنا كل خير وانول بهذا دعوه صالحه لى ولجميع اخوانى واساتذتى جزاهم الله خيرا وحتى لا اكون ممن كتم علما هذا الدرس لايضاح الفرق فى استخدام النقطه . و علامة التعجب ! ومرفق مثال للتوضيح اكثر مثلا الكود التالى سوف يعرض رساله وبها اسم النموذج Private Sub bt4 points
-
هذا هو المرفق أرجو أن ينفع الله به أحدا من المسلمين المرفق يحتاج اضافة مرجع كما بالصورة المراجع والمصادر: 1- من شركة مايكروسوفت 2- لمزيد من الشرح والتوضيح من معلمنا أ/ جعفر MenuAndShortCutMenu.rar InsertReference.rar4 points
-
وعليكم السلام 🙂 حتى لا يحدث لك هذا مرة ثانية: 1. تأكد بأن برنامج الاكسس فيه آخر التحديثات ، 2. هذا قد يكون بسبب بعض تحديثات مايكروسوفت للوندوز ، من موقع مايكروسوفت: Access reports that databases are in an 'inconsistent state' - Access (microsoft.com) - يكفي عمل هذا العمل على السيرفر (او الكمبيوتر الذي عليه نسخة الجداول) ، ولا يضر ان تعمله على كمبيوتر الواجهة وكمبيوتر الجداول : - افتح برنامج CMD كمسؤول ، Windows Start and then type Command. Right-click on Command Prompt and choose Run as administrator - ثم اكتب هذه الاسطر الثلاث (انسخ اول سطر4 points
-
السلام عليكم مرحبا اخي ابو حسان دائما السائل الذي لا يتقيد بقواعد المشاركة يتعجب لماذا لا يتم الرد من الاخوة الاعضاء ، ولا يدري انه هو السبب ومن ضمن هذه القواعد والتي لم يتم مراعاتها هنا هو ادراج اكثر من طلب في موضوع واحد ، في هذه الحال يتحاشى الاعضاء الرد على احدها لانه سيكون ملزم بايجاد حلول لباقي الطلبات ، وقد يكون وقت العضو لا يسمح ، او ان بعض الاستفسارات تصعب عليه .. ولا ننسى ان طرح سؤال واحد افضل وارسخ في التعلم نحن دائما نغلق مثل هذه المواضيع ونطلب من السائل اعادة طرح موضوعه مع مراعات قوانين المشاركة ارى الافضل لك ان تطرح استفساراتك بمشاركات منفصلة كل سؤال ف4 points
-
وعليكم السلام-كان يجب عليك استخدام خاصية البحث بالمنتدى -تفضل دمج ملف اكسل بملف صوتي وهذا فيديو اخر4 points
-
4 points
-
وعليكم السلام يمكنك ذلك من خلال التنسيقات الشرطية بهذه المعادلة =and($C2<=TODAY()-3,$c2<>"") متابعة1.xlsx4 points
-
أكثر اختصاراً Sub test() Dim a As Variant Dim i As Long Dim sh1 As Worksheet: Dim sh2 As Worksheet: Dim sh3 As Worksheet Set sh1 = Sheets("sheet1"): Set sh2 = Sheets("sheet2"): Set sh3 = Sheets("sheet3") a = Split(Join(Application.Transpose(sh2.Range("b3:b" & sh2.Cells(Rows.Count, 2).End(xlUp).Row)), "#") _ & "#" & Join(Application.Transpose(sh3.Range("b3:b" & sh3.Cells(Rows.Count, 2).End(xlUp).Row)), "#"), "#") With CreateObject("scripting.dictionary") For i = 0 To UBound(a) If a(i) <> "" Then4 points
-
جرب هذه المحاولة بمجرد الكتابة في الخلية c2 سيتم جلب البيانات غير اسماء الشيتات اجعل ورقة البيانات"data" وورقة التقرير report وضع الكود في ورقة التقرير Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("c2")) Is Nothing Then Sheets("data").Cells.AutoFilter Field:=1, Criteria1:=Target.Value Sheets("data").AutoFilter.Range.Columns("A:q").Offset(1).Copy Sheets("report").Range("A10") End If Sheets("data").AutoFilterMode = False End Sub4 points
-
فورم دخول ب 2 سرى مع تحريك ليبل فى الفورم يخفى السرى الاكواد اسفل الفيديو4 points
-
السلام عليكم ورحمة الله هذا الكود لاستدعاء اسم السيارة بناءا على رقمها اما موضوع تحويل التاريخ من هجرى الى ميلادى اتمنى ان بساعدك فى احد الاخوة لضيق الوقت لدى Sub CarsNames() Dim ws As Worksheet, Sh As Worksheet Dim LR As Long, i As Long Dim Car As String, CarNum As String Dim WF As Variant Set ws = Sheets("Sheet1") Set Sh = Sheets("Plate_No") Set WF = WorksheetFunction LR = ws.Range("A" & Rows.Count).End(xlUp).Row i = 6 Do While i <= LR CarNum = ws.Range("J" & i).Value Car = WF.Index(Sh.Range("A2:B" & Sh.Range("B" & Rows.Count).End(3).Row), _ WF.Match(CarNum,3 points
-
ماكرو بحث واستبدال اسم أو رقم بفورم الاكسل وبعددة طرق الفيديو الصور3 points
-
3 points
-
وعليكم السلام وحمة الله وبركاته تفضل اخي الكريم B: [التوصية] & " " & Format([التاريخ];"yyyy/mm/dd") & " " & [الملاحظة] مثال للتاريخ.rar تحياتي3 points
-
لا أعرف سبب التركيز على الحلقات التكرارية في أكثر الاكواد في حين يمكن عمل ذلك بواسطة فلتر بسيط Option Explicit Sub test_salim() Dim ws As Worksheet Dim ws2 As Worksheet Set ws = Sheets("البيانات") Set ws2 = Sheets("التقرير") If ActiveSheet.Name <> ws2.Name Then ws2.Select ws.AutoFilterMode = 0 ws2.Range("A10").CurrentRegion.Clear ws.Range("A9").CurrentRegion.AutoFilter 1, ws2.[c2] ws.Range("A10").SpecialCells(12).Copy ws2.Range("A10").PasteSpecial (8) ws2.Range("A10").PasteSpecial (11) Application.CutCopyMode = 0 ws.AutoFilterMode = 0 End Sub3 points