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

وعليكم السلام اتفضل ان شاء الله يكون ما تريد If DateSerial(Year(Date), Month(Date), 10) = Date Then MsgBox "yes" بالتوفيق

تنور مصر ولو ابوجودى معزمكش اعزمك انا 🇪🇬

صراحة.......منتدى مليء بالأكفاء ... أبو إيمان / محمد حسن المحمد /أ / محمد صالح أشكركم من أعماق قلبي على مابذلتموه من تألق ورد يعجز لساني عن وصفه.

مشاركة مع اساتذة الأكارم جرب هذا المرفق ووافنا بالنتائج SearchInSubandMain mod..accdb

ع راسى من فوق وان معرفتش هنبحث مع بعض باذن الله ربنا يوفقك تنور مصر يابشمهندس ندبحلك البط كله وياريت كان فى وز ندبحهولك 😀

اخي الكريم munear جرب المرفق ..ادخل المودييل اولا ثم تاريخ الاستلام تثبيت معادلة.xlsm

تحياتي لكم جميعا هذا الموضوع شيق جدآ أتمني أن تبرمج اداه لسحب المتعدد من الفيدر في الاسكنر ويمكن التعامل عليها من الاكسس

تفضل ...الملف ...اتمنا من الله ان يكون هو المطلوب !!! تثبيت معادلة (1).xlsm

تفضل الملف تثبيت معادلة.xlsm الكود المستخدم Sub tast() Application.ScreenUpdating = False Range("E10").Select ActiveCell.FormulaR1C1 = _ "=IF(RC[6]>1,VLOOKUP(RC[3],أسعار!C[-3]:C[-2],2,),"""")" Range("E10").Select Selection.AutoFill Destination:=Range("E10:E405") Range("E10:E405").Select Selection.Copy Range("E10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("E10").Select Application.ScreenUpdating = True End Sub هل هذا ما تريد ؟

جرب المرفق تثبيت معادلة.xlsm

السلام عليكم تفضل يجب عليك تغير امتداد الملف ليصبح هكذا xlsm. الملف test.xlsm

Option Explicit Sub stabelerFR() Dim lr Dim r lr = Cells(Rows.Count, "e").End(3).Row r = "=VLOOKUP(H10,أسعار!B:C,2,)" Range("e10:e" & lr).Formula = r Range("e10:e" & lr).Value = Range("e10:e" & lr).Value End Sub استعمل هذا الشيء سيفي بالغرض ..ولكن لازم تحفظ الملف بامتداد xlsm

You can change the date in the code Sub Test() Const sReport As String = "Report" Dim ws As Worksheet, myDate As Date, lr As Long, r As Long, c As Long, k As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) lr = ws.Cells(Rows.Count, "C").End(xlUp).Row myDate = CLng(DateSerial(2017, 1, 1)) ReDim a(1 To (lr - 2) * 7, 1 To 6) For r = 3 To lr For c = 9 To 27 Step 3 If ws.Cells(r, c + 1).Value2 >= myDate Then k = k + 1 a(k, 1) = ws.Cells(r, 3).Value a(k, 2) = ws.Cells(r, 6).Value a(k, 3) = ws.Cells(r, 7).Value a(k, 4) = ws.Cells(r, c).Value a(k, 5) = ws.Cells(r, c + 1).Value a(k, 6) = ws.Cells(r, c + 2).Value End If Next c Next r If k > 0 Then On Error Resume Next Application.DisplayAlerts = False Worksheets(sReport).Delete Application.DisplayAlerts = True On Error GoTo 0 Sheets.Add(After:=Sheets(Sheets.Count)).Name = sReport With Worksheets(sReport) .DisplayRightToLeft = True .Range("A1").Resize(, 6).Value = Array("Father Name", "Mother Name", "Place", "Child", "Birth Date", "ID") .Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a .Columns.AutoFit End With End If Application.ScreenUpdating = True MsgBox "Done...", 64, "LionHeart" End Sub

بعد إذن جميع المشاركين إذا جربنا وضع الرقم 10 كدرجة رئيسية والرقم 90 و 300 كدرجات ثانوية سنتأكد من صحة المعادلتين في هذا الملف المرفق خالص الدعوات بالتوفيق الزاوية الأقرب.xlsx

صارلي زمان مش واكل بطة ع الرز اذا بشمهنس محمد (ابو جودي ) بيعزمني ... حروح على طول لمصر الحبيبة

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

السلام عليكم, في سنة 2017 قمت بكتابة كلاس بسيط لحماية برنامجي ولضمان برنامجي لا يعمل في غير كومبيوترات في حاله بيعه. مميزات الكلاس: 1- قفل قاعدة البيانات على ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) 2- (استحاله) فك النماذج والتقارير في حال عدم تجاوزك لنموذج ( تسجيل الدخول ) ببساطة ستقول يمكنني العثور على باسورد القاعدة داخل الجدول ( الطريقة المعتادة لدينا جميعا في انشاء نموذج تسجيل دخول ). قبل كل شي ليكن لدينا مثلا جدول اسمة ( tbl_Login ) و نموذج اسمه ( frm_Login ) الجدول لتخزين اسم المستخدم وكلمة المرور والنموذج لعمل تسجيل الدخول عند ذهابنا للجدول ( tbl_Login ) ، سوف نحصل على باسورد مشفر من الجدول لو كان الباسورد مثلا ( 313 ) فإنك ستحصل على ( 701D6068 ) 2- عندما نقوم بتسجيل الدخول في النموذج سيقوم البرنامج بأخذ كلمة السر المدخلة ويقوم بتشفيرها ثم يقوم بمطابقتها مع الباسورد الموجود في الجدول اذا كان الباسورد المُدخل يطابق الجدول سيكتب قيمة معينة runtime ويقوم بازالة جميع القيود من النماذج والتقارير. اولا: كلاس الحماية Option Compare Database '----------------------------------------------------- ' Protection Module Coded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- Public SEMO As String Function SEMO_GET() SEMO = SEMO SEMO_GET = SEMO End Function Function PR() As Boolean PR = False 'False=Disabled , True=Enabled End Function Function HWND_ID() HWND_ID = "3C3F4825" 'Your HWID End Function Function HWND_MSG() HWND_MSG = "...ليست لديك صلاحيات كافية لإستخدام هذا الاجراء" End Function Function KEY_ENDE() KEY_ENDE = "PA$X" End Function Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function Function HWND_PROTECTION() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_PROTECTION = disk.volumeserialnumber Exit For End If Next If HWND_ID = HWND_PROTECTION Then HWND_PROTECTION = "True" Else HWND_PROTECTION = "False" End If End Function 'Code contained within module named mdlforencryptionanddecryption Public Function XORDecryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To (Len(DataIn) / 2) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Val("&H" & (Mid(DataIn, (2 * arkdata1) - 1, 2))) 'The second value comes from the code key intXOrValue2 = Asc(Mid(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2) Next arkdata1 XORDecryption = strDataOut End Function Public Function XOREncryption(CodeKey As String, DataIn As String) As String Dim arkdata1 As Long Dim strDataOut As String Dim temp As Integer Dim tempstring As String Dim intXOrValue1 As Integer Dim intXOrValue2 As Integer For arkdata1 = 1 To Len(DataIn) 'The first value to be XOr-ed comes from the data to be encrypted intXOrValue1 = Asc(Mid$(DataIn, arkdata1, 1)) 'The second value comes from the code key intXOrValue2 = Asc(Mid$(CodeKey, ((arkdata1 Mod Len(CodeKey)) + 1), 1)) temp = (intXOrValue1 Xor intXOrValue2) tempstring = Hex(temp) If Len(tempstring) = 1 Then tempstring = "0" & tempstring strDataOut = strDataOut + tempstring Next arkdata1 XOREncryption = strDataOut End Function الاستخدام لكل النماذج والتقارير اكتب في حدث Form_Load Option Compare Database Private Sub Form_Load() On Error Resume Next If HWND_PROTECTION = "False" Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim X As Control Set X = Me.Controls.Item(i) X.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If If Protection.SEMO_GET = "SEMO" = False Then MsgBox HWND_MSG, vbCritical, "عملية خاطئة" For i = 0 To Controls.Count - 1 Dim XS As Control Set XS = Me.Controls.Item(i) XS.Visible = False Next DoCmd.Close DoCmd.CloseDatabase DoCmd.Quit End If End Sub الان عندما تريد اعطاء القاعدة لشخص ما قم باعطاءه اولا ملف الـ VBS هذا '----------------------------------------------------- ' ReCoded By Hassanein Hirz Aldeen (SEMO.Pa3x) ' Date 26/11/2017 ' All rights reserved. copyright © 2017 '----------------------------------------------------- ' Get clipboard text Set objHTML = CreateObject("htmlfile") Set Ws = CreateObject("WScript.Shell") Clipboardtext = objHTML.ParentWindow.ClipboardData.GetData("text") sText = HWND_GET 'Set Clipboard Ws.Run "mshta.exe ""javascript:clipboardData.setData('text','" & Replace(Replace(sText, "\", "\\"), "'", "\'") & "');close();""", 0, True MsgBox "Copied!" Function HWND_GET() Set root = GetObject("winmgmts:{impersonationlevel=impersonate}!\\.\root\cimv2") Set disks = root.execquery("select * from win32_logicaldisk") For Each disk In disks If disk.volumeserialnumber <> "" Then HWND_GET = disk.volumeserialnumber Exit For End If Next End Function وظيفة هذا الملف يقوم باستخراج ( رقم الهارد , البروسيسور , المذربورد , الماك أدريس ) ثم ينسخه بعدما يشغله سيقوم العميل باعطاءك هذا الرقم لكي تقوم انت بدورك بوضعه داخل الكلاس في المنطقة Function HWND_ID() HWND_ID = "Your HWID" End Function استبدل كلمة ( Your HWID ) بالرقم الذي سيعطيه لك العميل. ثم بعد ذلك قم بحفظ القاعدة بصيغة ( ACCDE ) واتحدا اي شخص يفتحها مرة اخرى: لكي تفتح النماذج والتقارير عليك بتخطي نموذج تسجيل الدخول ارفقت لكم قاعدة محمية وقاعدة بدون حماية مع ملف الـ VBS الذي يستخرج ارقام قطع الجهاز ويقوم بنسخها،، اتمنى لكم الفائدة جميعاً اهداء الموضوع الى مُعلمي الرائع @jjafferr حسنين Login_SEMO_Pa3x.rar

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته يسرني اليوم أن أقدم لكم هذه الهدية الرمضانية المتميزة والرائعة 😊 ( الكاتب الذكي لدوال المجال في أكسس ) Dloockup, DCount, DMax, DMin, Dfirst, DLast , DSum, DAvg هذه الأسطورة هي عبارة عن أداة صممتها في أكسس ( بفضل الله وحمده ) تقوم بكتابة دوال المجال نيابة عنك بشكل آلي .. وتعطيك النتيجة بشكل مباشر 😉👌🏼 لن يخطيء أحد بعد اليوم في كتابة جملة هذه الدوال إن شاء الله 😁 كل ما عليك فعله هو استيراد هذه الأداة لبرنامجك ثم اختيار الجدول أو الاستعلام المطلوب والحقل المراد وبعدها سترى العجب العجاب 🙂 ✨ ومن مزاياها :✨ 1 - تسهل عليك كتابة أسماء الجداول والحقول ( فقط تختارها من القائمة المنسدلة ) . 2- يحل مشكلة تداخل النصوص عند استخدامها مع الجداول والحقول المكتوبة باللغة العربية . 3- تفحص لك النتيجة مباشرة للتأكد من أنك ستحصل على البيانات التي تريدها . 4 - سهلة الاستخدام فقط اتبع الخطوات الموضحة وتأكد من اختيار نوع البيانات الصحيح . 5 - يمكنك عمل دالة بأربعة 4 معايير بكل سهولة ويسر . 6 - يمكنك عمل تعديلاتك الخاصة على الدالة مباشرة وفحص النتيجة مباشرة بعد التعديل على النتيجة النهائية . 7 - إمكانية الحصول على الصيغة الخاصة بمحرر الأكواد VBA أو الصيغة المستخدمة في الاستعلامات ومنشيء التعبير . 8- إمكانية استخدام الأداة بشكل مستقل من غير الحاجة لنقلها إلى برنامجك . 9- وغيرها الكثير مما سيفتح الله عليكم اكتشافه بأنفسكم إن شاء الله 😅 طريقة الاستخدام : سهلة يسيرة بحمد الله .. فقط قم بسحب النموذج المسمى SmartDomainFunctionsBuilder_F إلى برنامجك عن طريق السحب والإفلات .. ثم قم بفتح النموذج عندك وسوف يقوم هو آليا بالتعرف على الجداول والاستعلامات الخاصة ببرنامجك بدون الحاجة إلى جهد يذكر 🙂 ( مع إمكانية استخدام الأداة بشكل مستقل من غير الحاجة لنقلها لبرنامجك ولكنك ستفقد الكثير من المميزات 😉 ) الأداة تم عمل الكثير من التجارب عليها وتم تلافي العديد من الأخطاء وإصلاحها بحمد الله وفضله... ولكن لا زلت لا أستغني عن آراءكم وملاحظاتكم من خلال استخدامكم لها 😉 الشرح بالتفصيل : 🙂 وهنا قمت بشرح الأداة بشكل مفصل نوعا ما في مقطع فيديو مدته نصف ساعة تقريبا : وأخيرا التحميل 😊 تحميل الملف الأصلي : >> حمل من هنا آخر إصدار للأداة << تحميل الملف بلمسات المهندس العزيز @د.كاف يار : د.كاف يار __Domain Functions Builder V1.0.accdb وأهم من الأداة نفسها 😉 لا تنسوني من صالح دعائكم لي ولوالدي .. ولا تحرموني من آرائكم ومقترحاتكم ونصحكم وإرشادكم 🙂 أخوكم ومحبكم موسى الكلباني 😊 ‏‏Domain Functions Builder V1.0.accdb

السلام عليكم منتدى اوفيسنا كل عام وانتم بخير لدي ملف مكون الفين صف بها اسم الاب واسماء الاطفال وتواريخم بجانبهم اريد فرز تاريخ معين لاعمار الاطفال لكل الاعمدة لكي يظهر اسم الاب بجانب الاطفال الظاهرة مع تاريخها الملف به بعض البيانات لبعض العوائل واذا كان الحل تغيير تنسيق الجدول لا مشكلة لكن هناك بيانات لاعمدة اخرى لم اضعها او ان استطيع حلها عن طريق بيفت تيبل . test.xlsx

اين هذه الاحداث فى فورم ايه ؟ يتم تغييرها بالفورم الذى تتبع له اى بالفورم ثم بالتوفيق

السلام عليكم ورحمة الله لدي مثال في المرفقات وهو نمودج رئيسي به ثلاث حقول ملحق به نمودج فرعي به تلات حقول ايضا . المطلوب عند الضغط على امر " سجل جديد " و بعد تعبئة التلات حقول الاولى في النمودج الرئيسي ينتقل الموشر الى النمود ج الفرعي واجبار الكتابة في الحقل الاول بشرط عدم مغادرته للحقل الا بعد الكتابة به تم الانتقال تلقائيا الى الحقل التاني وتنفيد نفس الاجراء السابق حتى ينتقل للحقل التالت ارجو ان اكون قد احسنت الشرح ولكم جزيل الشكر اخواني والسلام عليكم وكل سنه وانتم طيبين SearchInSubandMain3 (1)1.accdb

العفو والشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا يجب تغيير الاحداث لكى تناديها من اماكن اخرى هتشيل كلمه Private وتسيبها او تكتب public ثم اتبع شرح اخى ومعلمى العزيز جعفر ببساطه بالتوفيق

قيمة رقمية.accdb

ربنا يبارك فيك يا غالى

اخي بالفعل هذا ما تم عملة ----عند الضغط علي زر طباعة مدي الناجحين يتم حفظ ملف pdf علي برتيشن d اخي يوجد شرط لتنفيز المطلوب لديك .... الشرط كتابة النتيجة ناجح اولاً قم بكتابة كلمة ناجح امام النتيجة ... ثم اضغط زر طباعة مدي الناجحين ..وسف يقوم الكود بعمل اللازم تفضل الملف مرة اخري شهادات ,والراسبين 4 تعريق متغيرات.xlsm

السلام عليكم ,, الاخوة الاعزاء كل عام وانتم بخير . كما نعلم ان الايقونات جزء لا يتجزء من الواجهات الحديثة الجذابة التى تلفت الانظار ومن هذا المنطلق واستكمالاً للموضوع السابق الذى تجده هنا : موضوعنا اليوم عن كيف تصنع ايقوناتك خصيصاً لتتناسب مع تصميم برنامجك بطريقة بسيطة , انظر النتيجة : هناك اختلاف بسيط فى الالوان لأنى عملتهم على عجالة 😅 . فى هذا الموضوع سنستخدم أداة بها آلاف الايقونات القابلة للتخصيص من حيث اللون والحجم اسم الاداة Pichon يمكنك تحميلها من هذا الرابط المباشر : من هنا بعد التحميل والتثبيت ستجد هذه الايقونة افتح البرنامج وابحث عن الايقونة التى تريدها بوصفها مثلاً Facebook , Twitter وهكذا , ستجد ايقونات غير قابلة للتخصيص ولكن يمكن التحكم فى حجمها وستجد ايقونات يمكن تغيير ألوانها ستجدها تحت تصنيف Material وبها تصنيفات فرعية مثلا Outlined للايقونات المفرغة و Filled للايقونات الممتلئة , ابحث ن الايقونة وقم بتلوينها مثل المثال : اضغط كليك يمين ثم Save As واحفظ الايقونة شفافة يمكن وضعها على اى تصميم طيب انا محتاج لون دقيق جدا حتى يكون هناك تناسق تام فى الألوان والتصميم فى هذه الحالة يمكنك سحب اللون بالاداة الموجودة فى الموضوع السابق اتبع المثال لسحب لون الاكسس المحبوب على سبيل المثال : لا حدود لما يمكنك ابداعه , بتطبيق ما تعلمته من الدرسين يمكنك عمل Themes يقوم المستخدم بنحديد المفضل لديه ويتم تغيير الوان الازرار والايقونات وشريط العنوان ليصبح برنامجك شبيهاً ببرامج .Net 😅 المطلوب دعوة بظهر الغيب لصلاح الحال وتيسير الامور , دمتم بخير مرفق المثال الاول لتغيير الوان الحروف والايقونات المستخدمة Icon Color Amr.rar

تم وضعها بالخطة 😅 , من باب الفضول ماهو نوع الاسكانر المستخدم ؟

شاهد المرفق Tq.xlsm

أحسنت أستاذي بارك الله فيك

السلام عليكم بعد اذن استاذنا حسين مامون ..جرب هذا الكود Sub tast() Application.ScreenUpdating = False Range("E10:E405").Select ActiveCell.FormulaR1C1 = _ "=IFERROR(VLOOKUP(R10C8:R[395]C[3],أسعار!C[-3]:C[-2],2,),"""")" Range("E10").Select Selection.AutoFill Destination:=Range("E10:E5000") Range("E10:E5000").Select Selection.Copy Range("E10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ActiveSheet.Paste Application.CutCopyMode = False Range("E10").Select Application.ScreenUpdating = True End Sub الملف تثبيت معادلة.xlsm

أهلا بك أستاذ @higo2015 🙂 تفضل أستاذي هذه الطريقة - تحسب لك عدد وجبات الغداء التي تقع في الساعة 12 ظهر // ووجبات العشاء الساعة 9 مساءا // وعدد الليالي الساعة 12 ليلا : باستخدام الدالة التالية : Public Function LunchNDinnerNights(StartDate As Date, EndDate As Date) As String Dim SH As Integer 'Start Hour Dim TH As Integer 'Total Hours Dim x As Integer Dim H As Integer Dim L As Integer 'Lunches Dim D As Integer 'Dinners Dim N As Integer 'Nights SH = Format(StartDate, "HH") 'Debug.Print "Start Hour=" & SH TH = DateDiff("H", StartDate, EndDate) 'Debug.Print "Total Hours=" & TH For x = 0 To TH H = Format(DateAdd("h", x, StartDate), "HH") 'Debug.Print "Hour=" & H If H = 12 Then L = L + 1 If H = 21 Then D = D + 1 If H = 0 Then N = N + 1 Next x LunchNDinnerNights = L & " Lunch , " & D & " Dinner , " & N & " Night ." End Function ثم تناديها هكذا : If IsNull(Me.StartText) Or IsNull(Me.EndText) Then Exit Sub Me.ResultText = LunchNDinnerNights(Me.StartText, Me.EndText) مع مراعات أن تضع تنسيق التاريخ في المربعات بالصورة التالية : dd/mm/yyyy hh:nn:ss AM/PM جربها وأخبرني برأيك 🙂 أدركتم العشاء والمبيت.accdb

اخي اعمل مثال لما تتوقعة للنيجة الفرز ربما يستطيع احد الاخوة المساعدة

انت عامل كل شي فقط محتاج... Me.Requery

السلام عليكم مشاركه مع اخى واستاذى موسى جزاه الله خيرا اخى @SAROOK اطلع عالتعديلات التى قمت بها ولى عوده مره اخرى بالمساء ان شاء الله بعد ان تقوم بالتجربه والرد هل ده المطلوب ام لا بالتوفيق Search_.accdb

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

الحمد لله الذي بنعمته تتم الصالحات جزاكم الله خيراً على هذه الكلمات الطيبة

بعد إذن الأساتذة الأفضل إثرائا للموضوع يمكن ذلك من خلال التالي =IF(J4>0;HYPERLINK(CONCATENATE("PDF/";J4;".pdf");"الاطلاع على العقد");"")

شاهد المرفق Tq.xlsm

السلام عليكم ..التعديل هنا Range("B45:H191").Copy تفضل الملف vehicles Cost.xlsm

Delete columns from column A to column G Select column A From Data tab select Text to Columns Select Delimited option and click Next button Check Space option and click Next button In Destination field select $B$1 cell And finally click Finish

اولا- اتقدم بخالص التهاني لخبيرنا واستاذنا @احمد الفلاحجي ابو بسملة جزاه الله خيرا علي الترقية ثانيا- جزاك الله خيرا أستاذنا @Amr Ashraf مبادرة طيبة وعرض مغري حقيقة - ولكني من انصار المثل الصيني - علمني الصيد ولا تعطني سمكة - فيا حبذا لو انتهز حماسكم بتلك المبادرة واطلب منكم انشاء موضوعات ولو صغيرة تشرحون بها ما تعلمتم من اصول ومبادئ تلك اللغة علي شكل مشروعات مصغرة او اي صورة تروق لك حسبما تيسر من الوقت والجهد وجعله الله بموازين حسناتكم - اهو منها مذاكرة ومنها افادة - حتي لو كل يوم درس مش هنتقل عليك - جزاكم الله خيرا واحسن الله اليكم

انا بتكلم عن الC# مش فرع الC بالكامل , السى شارب استحدثت فى 2002 وتعتبر حديثة بالنسبة للغات كثيرة . منكم نستفيد يا ابو جودى انا بشغل بالى عشان لو وقف قدامى حاجة الاقى حد اسأله او منتدى مقعدش جنبه شهر لحد ما حد يرد عليا 😅 فهمت قصدى ؟ الخطوة الجاية قريباً جدا استاذنا , فعلا اسمع انه الحديث كله wpf وان الWinForm قرب يتقرض مش عارف ليه ده انا لسة بادئ , عامة هتجول شوية فى الWpf بس حالياً شغال على نظام ERP متكامل لشغلى وهياخد منى شوية وقت . زادكم الله من فضله استاذنا الفاضل , وجزاكم الله خير على المناقشة القيمة .

للعلم هذا اختيار موقف وللعلم ان اردت النقر على هذا الباب ابتعد عن VB.Net هى ليست حديثه بدأت اللغة كما عرفت اولا بـالـ C ثم الـ C++ ثم الـ C# https://ar.wikipedia.org/wiki/سي%2B%2B ثم تم التطوير بعد ذلك https://ar.wikipedia.org/wiki/سي_شارب وذلك لتنافس Java ولغات البرمجة الاخرى

اخترت C# لأن الSyntax مختلف تماماً عن VBA فأحسست فى البداية بالتحدى لتعلم شئ جديد , بالنسبة للVB.Net قريب جدا من VBA لم اشعر بالحماس للتعمق فيه . سؤال جيد , كما تعلم ان لكل فرع منهم المجال الذى يتألق فيه وبما أنى مهتم كثيراً بDesktop Applications فاخترت الدوت نت وهذا أولاً , ثانياً المجتمع العالمى ومدى انتشار اللغة البرمجية عامل مهم فى اختيارى وكان ايضاً سبب قوى انى اخترت الC# فلها قاعدة شعبية عالية جداً وهى لغة حديثة ومازالت تتطور مع الوقت كما انه يمكنك تصميم تطبيقات الاندرويد و مواقع الويب بالاضافة الى برامج الويندوز والماك عن طريقها . بالنسبة للبايثون غير منتشر بالدرجة الكافية حتى الآن ومجال تألقه هو الذكاء الصناعى , بالنسبة لمدى القوة فهى لغة قوية جداً بالفعل ولكن كما قلت شعبية اللغة وكثرة مستخدميها يفيد المبتدئين امثالى من كافة الجهات . بالنسبة للجافا احسها لغة متكاملة تنفع فى أى مكان وتصلح لأى شئ ولكن فضلت تركها بعد تعلم الدوت نت اذا أحيانا الله , وامكانيات الجهاز الحالى لا اعتقد انها ستساعد فى البرمجة بالجافا . سؤالك كان جيد واعتقد انه هيفيد الكثير , تشرفت بمرورك

السلام عليكم , الاخوة الكرام كل عام وانتم بخير بمناسبة شهر رمضان وعيد الفطر المبارك اعادهم الله علينا بالخير والبركة موضوعنا اليوم بعد غياب كما بالعنوان كيف تنفذ شاشة متطورة حتى النتيجة بالمثال افتح فورم جديد ثم قم بعمل 2 Rectangle فى الجانب والاعلى , الجانب للقائمة والاعلى كشريط للعنوان , بالنسبة للون الخلفية الخاصة بهم يمكنك عمل اللون الذى تفضله , بالنسبة للون المثال هو لون قوائم Microsoft Outlook قمت بسحبه وتطبيقه هنا , السؤال كيف تسحب لون تريده ولا تعرف درجته بالضبط ؟ يمكنك تطبيق هذه الفكرة الجديدة , هناك اداة يستخدمها مطورين الويب و المصممين لسحب الألوان بدرجاتها بدقة عالية وهذه الأداة اسمها Just color picker انظر لشكلها وللصورة قم بتنزيلها من الموقع الرسمى من هنا https://annystudio.com/software/colorpicker/ وصورتها قم بفتح الاداة وقم بالاشارة على أى لون تريده ثم اضغط على Alt+x لحفظ درجة اللون بالطريقة التى تحبها HTML او RGB وفى المثال سنستخدم الطريقتين , بالنسبة للHTML يمكنك سحب اللون بالاداة واضغط على Copy Value مع التأشير على HTML كما بالصورة قم بنسخ القيمة وفى الاكسس فى الخصائص الخاصة بأى عنصر ستجد Back Color قم باضافة رمز # قبل درجة اللون من الاداة وضعها فى الاكسس وستجد ان اللون تم تطبيقه وبالتالى قمت بأخذ لونك المفضل ويمكنك محاكاة اى تصميم لاى برنامج تحبه . ننتقل للتصميم بداية التصميم من فكرتى وتطبيقى واكوادى من البداية اللى النهاية وأتمنى دعوة بظهر الغيب بصلاح الحال , فى التصميم ستجد ان عند تحديد زر من ازرار القائمة ستقوم الايقونة بالتحرك والخط يختلف و تصبح ايقونة الزر هى الايقونة الرئيسية بالأعلى , لعمل ذلك قم بفتح الفاجيوال بيزيك وضع الاكواد التالية : Sub ReFormat(Sender As CommandButton) Me.PictureBox.Picture = Sender.Picture Me.lbl.Caption = Sender.Caption Sender.PictureCaptionArrangement = acRight Sender.FontUnderline = True End Sub شرح الكود :: المطلوب معرفة اولا الزر الذى تم ضغطه ولذلك قمت بعمل الكود السابق مع التحكم فى الزر الذى تم ضغطه كمحازاة النص والايقونة وهكذا , يمكنك زيادة حجم الخط او أي تنسيق تريده. يتم استدعاء الكود بالشكل التالى من أى زر امر : ReFormat ActiveControl تمام , طيب فى هذه الحالة التنسيق سيستمر اذا ضغطت على زر آخر وستظل الايقونة والخط بالتنسيق الذى قام الكود السابق بعمله , وبالتالى محتاجين نلغى ما قام به الكود السابق عن كل الازرار الا الزر الحالى سيحتفظ بالتنسيق الجديد . عملت الكود التالى Sub Restore() Dim ctrl As Control For Each ctrl In Me.Controls If TypeName(ctrl) = "CommandButton" Then If ctrl.Name <> ActiveControl.Name Then ctrl.PictureCaptionArrangement = acLeft ctrl.FontUnderline = False End If End If Next End Sub شرح الكود :: يقوم بالمرور على كل عناصر التحكم واذا وجدها زر سيقارن اسمها مع اسم الزر الحالى فى حالة اختلافهما يقوم بارجاع التنسيق الاصلى للزر قبل تطبيق كود التنسيق عليه , وبالتالى مع كل زر امر سيتم وضع الكود التالى Restore ReFormat ActiveControl ستجد ان هناك خط يتغير لونه مع كل ضغطة زر , هنا سنستخدم طريقة الالوان الاخرى RGB قم بسحب اللون الذى تريده بالاداة وقم بوضع اللون مثل المثال التالى : Me.Line51.BorderColor = RGB(35, 204, 183) حيث ان قيمة اللون بين الاقواس الاحمر,الاخضر,الازرق RGB . باقى TabControl متعدد الصفحات قم بانشاءه ولا تنسى بعد الانتهاء منه تحديد Style = None الخطوة الاخيرة الانتقال الى صفحات هذا الTabControl عن طريق الكود وهناك طريقتين : اذا اردت تحديد الصفحة المطلوبة والوقوف عليها يمكنك استخدام : Me.MyTabs.Pages(0).SetFocus حيث ان 0 هو رقم Index او ترتيب الصفحة فى المستعرض , وستجد عند فتح النموذج ان الصفحة 0 يتم فتحها وعند الضغط ايضاً على ايقونة المنزل سينتقل اليها . اذا اردت فتح الصفحة بدون الوقوف فيها يمكنك استخدام : Me.MyTabs.Value = 0 وستجد الطريقتين فى المثال المرفق . لا تنسى ضبط خاصية Anchor لتثبيت العناصر او مدها مع تكبير او تصغير النموذج كما فى المثال . اعتذر عن الشرح قليل التفاصيل الى حد ما ولكنى معتمد على خبرتكم . مرفق مثال به كل ما تم شرحه , دمتم بخير ستجد المثال فى اول مشاركة لأن المنتدى لم يسمح لى ان تتعدى المرفقات 4.8 ميجا . المثال مرفق Modern UI Access - Amr Ashraf.accdb قمت باضافة صغيرة لم تظهر فى الصورة المتحركة لأنها سجلت مسبقاً , عند الضغط على صورة المنزل ستعود كافة الايقونات الى مكانها الطبيعى .

بعد ادن استادي Ali Mohamed Ali واتراء للموضوع هذه طريق اخرئ 1- حمل الملف وفك الضغط 2 بعد فتح ملف اكسيل حدد اسم ملف بدف واضغط الزر ملاحظة: يجب ان تخزن الملفات ب د ف في نفس الفولدر"oqoud" مع ملف اكسيل و اسمارها ايضا في الصفحة كما في المرفق oqoud.rar

لا اجد رد يعبر عن مدى احترامى وشكرى لكل من اعضاء هذا المنتدى المحترم الذى تعلمت منه الكتير والكثير شكرا لك ا/ على محمد على

السلام عليكم .. الاخوة الافاضل الموضوع اليوم بسيط وسريع ويتحدث عن طريقة عمل قوائم مختصرة منبثقة من الازرار مثل الصورة التالية : الفكرة كلها ان عندى نموذج به الكثير من الازرار فبحثت عن طرق لاختصار الاوامر كلها فى زر او اثنين وبالتالى وصلت الى الفكرة التالية. اول خطوة عمل موديول جديد به الكود التالى : Sub MyMenu2() Dim Mnu As CommandBar, Itm As CommandBarControl Set Mnu = CommandBars.Add("", MsoBarPopUp, , True) Set Itm = Mnu.Controls.Add: Itm.Caption = "Export To PDF": Itm.OnAction = "amr3" Set Itm = Mnu.Controls.Add: Itm.Caption = "Export To Excel": Itm.OnAction = "amr4" Mnu.ShowPopup End Sub القائمة السابقة فيها امرين 2 فقط ويمكن زيادتها كما تريد بتكرار السطور وتغيير الاسماء , بالنسبة لAmr1 فى نهاية الجملة هو الامر المطلوب تنفيذه وسيتضح الموضوع من المثال المرفق . الخطوة الثانية : فى النموذج المطلوب تنفيذ الفكرة عليه , خلف زر الامر يتم وضع كود استدعاء للكود السابق كالتالى : Private Sub Command0_Click() MyMenu2 End Sub والنتيجة عند الضغط على الزر تنبثق القائمة كما فى الصورة السابقة . ملاحظات : قمت باضافة خيار آخر لاظهار القائمة وهو عن طريق الضغط على زر الفأرة الايسر مع زر الشفت فى نفس الوقت وستظهر القائمة ايضاً . يمكن تطبيق الطريقة فى التقارير والنماذج مع الاحتفاظ بالقائمة المختصرة الافتراضية الخاصة بزر الفأرة الأيمن وبالتالى سيصبح عند قائمتين مختصرتين اذا اردت الابقاء على الافتراضية . يجب تفعيل المكتبات الموجودة بالصورة حتى لا تواجه مشاكل . اترككم مع المثال لمزيد من التوضيح .. دمتم بخير Amr Magic Button.accdb

السلام عليكم .. اخوانى الكرام ,, بعد التحية موضوعنا اليوم عن النسخ الاحتياطى لمحتويات فولدر محدد فى وقت محدد من اليوم على اساس يومى او اسبوعى او شهرى كما تريد . قمت بتصميم نموذج فى القاعدة المرفقة يتم تحديد فيه الفولدر المطلوب نسخه و مكان حفظ النسخة والوقت الذى يتم فيه النسخ تلقائيا . كود النسخ المستخدم كالتالى : Public Sub Copy_Folder1() Dim FSO As Object Dim FromPath As String Dim ToPath As String FromPath = Forms!Frm!from 'ToPath = "D:\Old\test" '<< Change ToPath = Forms!Frm!To2 & Format(Now, "yyyy-mm-dd h-mm-ss") If Right(FromPath, 1) = "\" Then FromPath = Left(FromPath, Len(FromPath) - 1) End If If Right(ToPath, 1) = "\" Then ToPath = Left(ToPath, Len(ToPath) - 1) End If Set FSO = CreateObject("scripting.filesystemobject") If FSO.FolderExists(FromPath) = False Then MsgBox FromPath & "المسار المطلوب النسخ منه غير موجود" Exit Sub End If FSO.CopyFolder Source:=FromPath, Destination:=ToPath End Sub مميزات الكود : نسخ محتويات الفولدر بالكامل سواء ملفات او فولدرات فرعية . فى حالة عدم وجود المسار المطلوب وضع النسخة الاحتياطية فيه سيقوم بانشاءه تلقائياً. فى حالة وجود المسار وبه ملفات بنفس الاسم سيتم عمل Overwrite للملفات القديمة واستبدالها بالجديدة (وذلك فى حالة انك غيرت الاسم الذى يتم الحفظ به لأن الافتراضى يحفظ الاسم بالتاريخ ووقت الحفظ بالدقائق وبالتالى من الصعب تشابه الاسماء بين النسخ). شكل النموذج عند الضغط على تشغيل يقوم باستدعاء كود النسخ . فى حالة وصول وقت الجهاز الى الوقت المحدد بالنموذج يقوم باستدعاء كود النسخ . يمكنك كتابة المسار او اختياره عن طريق الازرار الموجودة بجوار الحقل النصى. لحد الآن موصلناش لجزئية التلقائى المذكورة فى العنوان 😅, من المعروف ان لازم تكون القاعدة مفتوحة حتى يعمل النسخ الاحتياطى وبالتالى فى حالة انك قمت بعمل استيراد للبرنامج ده داخل قاعدتك الاساسية المفتوحة طوال اليوم فلا مشكلة وعند وصول الوقت المحدد ستعمل بدون مشاكل .. ولكن ماذا لو اردت ان النسخ يتم حتى لو القاعدة مغلقة ؟ سنقوم بالاستفادة بخاصية مهمة موجودة فى الويندوز وبدون استخدام برامج خارجية تابع معى : فى قائمة Start ابحث عن Task Scheduler وهى خاصية تقوم بعمل مجموعة من الاوامر فى اوقات محددة مثل تشغيل برنامج او اغلاقه او ارسال ايميل مثلا الخ... هذه صورة الواجهة اضغط على Create Basic Task وستفتح لك الواجهة التالية : اكتب اسم المهمة المطلوبة ثم Next : هنا تكرار المهمة يوميا - اسبوعيا - شهريا - مرة واحدة - عند بداية التشغيل للجهاز - عندما اسجل دخول المستخدم - عند حدوث حدث معين . اختر ما يناسبك وفى حالتنا اخترت Daily يومياً . اختر تاريخ بداية العمل و الوقت المطلوب تشغيل المهمة فيه .التالى فى هذه الخطوة تختار ماهية المهمة فتح برنامج معين - ارسال ايميل - عرض رسالة محددة .. اختر Start Program فى حالتنا .. التالى فى هذه الخطوة تقوم باختيار مسار البرنامج المطلوب تشغيله وطبعا فى هذه الحالة البرنامج هو ميكروسوفت اكسس يتم تحديد مسار البرنامج من "C:" ثم تحديد القاعدة المطلوب تشغيلها فى Arguments بنفس الصيغة الموجودة بالصورة (بين علامتين تنصيص والمسار كامل بالامتداد ) #Program/Script "C:\Program Files\Microsoft Office\Office16\MSACCESS.EXE" #Arguments "C:\Users\Amr\Access\Backup\Tasker.Accdb" ثم اضغط على Finish. وبهذا قمنا بعمل مهمة للويندوز انه يفتح القاعدة الخاصة بنا فى وقت معين يومياً ,, باقى العمل داخل القاعدة نفسها كالتالى : فى حدث عند الفتح للنموذج ستجد الكود التالى : Private Sub Form_Open(Cancel As Integer) DoCmd.GoToRecord , , acFirst Me.To2 = [to] & "\" & [newnm] & " " Call SixHatHideWindow(SW_SHOWMINIMIZED) 'Call Copy_Folder1 '''' نقوم بتفعيل الخيار بعد تحديد الخيارات فى النموذج اول مرة لتعمل بتلقائية فيما بعد 'DoCmd.Quit '''' نقوم بتفعيل الخيار بعد تحديد الخيارات فى النموذج اول مرة لتعمل بتلقائية فيما بعد End Sub السطرين الغير مفعلين يتم تفعليهم بعد تحديد الخيارات الخاصة بيك من النموذج اول مرة وعند تفعيلهم بمجرد تشغيل القاعدة ستقوم بعملية النسخ وتغلق تلقائياً .. وبالتالى ملخص الفكرة ان القاعدة هتكون مغلقة وهتقوم مهمة الويندوز بتشغيلها وعند تشغيلها ستقوم بعمل النسخ الاحتياطى بالبيانات التى تم تحديدها اول مرة ثم تغلق تلقائياً وذلك فى اقل من ثانية قد لا تلاحظها من الاساس . مرفق القاعدة .. جرب ووافنى بالنتيجة .. دمتم بخير. ملحوظة : يمكن عمل المهمة الخاصة بالويندوز عن طريق اسكريبت VBS اختصارا للخطوات ولكن اردت شرح الفكرة من أساسها ويكون هناك مساحة للتطوير فيما بعد . BackupManual+Auto+Timer-AmrAshraf.accdb

وجدت طريقة اسهل .. اولاً الغي جميع ماسبق من خطوات واستخدمي فقط هذا الكود فيحدث "عند النقر" لزر ضغط واصلاح القاعدة واخبرينا بالنتيجة If MsgBox("هل ترغب في ضغط واصلاح بيانات القاعدة قبل إغلاقها" & vbCrLf & _ "اضغط على (لا) لإلغاء العملية . اضغط على (نعم) لضغط البيانات ", _ vbInformation + vbMsgBoxRight + vbYesNo + vbDefaultButton1, _ "تنبيه : رسالة تأكيد ضغط قاعدة البيانات واصلاحها") = vbYes Then Application.SetOption "Auto compact", True End If DoCmd.Quit