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

السلام عليكم ورحمة الله اخواتى واساتذتى لقد رأيت ان اشرح طريقة عمل ايقونة بطريقة بسيطة باستخدم خيارات الاكسس .. فقمت بشرحها على اليوتيوب لكي يستفيد منها كل الاعضاء المبتدئين وانا اعرف المنتدي غنى بمثل تلك المشاركة وبطرق مختلفة https://youtu.be/jav3HFmrbEE

مرفق صور وملف العمل وصورة للكود المستعمل ادارة العيادات الطبية.accdb

سيدي الفاضل ، ما قدرت اخلي التحديث اسرع من هاي 🙂 واذا السرعة عجبتك ، اخبرك كيف تجعلها اسرع ان شاء الله 🙂 جعفر 1134.jjafferr.accdb.zip

اذا البرنامج بصيغة mdb او mde ، فنعم في برامج لفك كلمة السر ، ولكن لا يوجد برنامج لفك كلمة السر للبرامج بصيغة accdb او accde ، فكل البرامج عندها محاولات لفك كلمة السر ، كما ذكرت في الرابط اعلاه 🙂 والحكم الانترنت ، ابحث ، وبتشوف النتائج 🙂 جعفر

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

السلام عليكم 🙂 سر ولازم اكشفه 🙂 في الكثير من المواضيع المهمة اللي اريد اتابعها ، ولكن بدون ان اضيف مشاركة ، اقدر اتابع هكذا : جعفر

السلام عليكم, في سنة 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

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

السلام عليكم و رحمة الله تعالى و بركاته أقدم لكم اليوم مرفقا يقوم بإضافة كلمة مرور جديد لملف الأكسس أو تعديل كلمة مرور قديمة أو حذفها نهائيا. 1- لإضاف كلمة مرور جديدة يجب ترك مربع كلمة السر القديمة فارغا و كتابة الكلمة الجديدة فقط ثم الضغط على زر الأمر 2- لتعديل كلمة المرور نكتب الكلمة القديمة و نكتب الكلمة الجديدة ثم الضغط على زر الأمر 1- لحذف كلمة المرور نكتب الكلمة القديمة ونترك مربع كلمة السر الجديدة فارغا ثم الضغط على زر الأمر و قد استخدمة هذه الوحدة النمطية: Public Function ChangePassword(path_file As String, Old_Password As String, New_Passwod As String) On Error GoTo err Dim odb As DAO.Database Set odb = DBEngine.OpenDatabase(path_file, True, False, ";pwd=" & Old_Password) odb.NewPassword Old_Password, New_Passwod MsgBox "لقد تم تغيير كلمة المرور بنجاح" fin: Set odb = Nothing Exit Function err: Select Case err.Number Case 3031 MsgBox "كلمة المرور غير صحيحة", vbCritical, "Sécurité" Case Else MsgBox err.Description, vbCritical, "Erreur No." & err.Number End Select Resume fin End Function و قمت بإستدعائها من خلال هذا الكود: Call ChangePassword(Me.txtpath1, Nz(Me.OldMot, ""), Nz(Me.NewMot, "")) تغيير كلمة السر برمجيا.rar

ماذا وجدت في المرفق الذي أرسلته لك أخي السيد

اعزكم الله اخى الكريم نحن لا نخفى اكواد على احد فقط نحن نخفى طريقتنا فى استغلال الكود ملخص الموضوع هذا او يدور حول قراءة ملفات النصوص اونلاين نحن نستغل هذا الموضوع وكل منا له طريقته فى استخدام الكود منا من يستخدمه فى التفعيل ومنا من يستخدمه فى التحديث وهكذا ... وهذا هو الكود Function GetFromWebpage(URL As String) As String On Error GoTo Err_GetFromWebpage Dim objWeb As Object Dim strXML As String ' Instantiate an instance of the web object Set objWeb = CreateObject("Microsoft.XMLHTTP") ' Pass the URL to the web object, and send the request objWeb.Open "GET", URL, False objWeb.send ' Look at the HTML string returned strXML = objWeb.responseText GetFromWebpage = strXML 'End_GetFromWebpage: ' Clean up after ourselves! Set objWeb = Nothing Exit Function Err_GetFromWebpage: ' Just in case there's an error! MsgBox Err.Description & " (" & Err.Number & ")" Resume End_GetFromWebpage End Function

استاذي القدير @ابا جودى لم افهم ما الغرض من ذلك المثال ؟؟ فهو يقرأ رقم الـ UUID ومن ثم يشفره ويتغير التشفير في كل مرة نضغط على نسخ .. ما الغرض من ذلك؟

الف الف الف شكر اخي واستاذي ومعلمي الاستاذ jjafferr نعم هذا مرة ممتاز بارك الله فيك وجعلها في ميزان حسناتك

استاذ sandanet النسخة بالفعل 2007 - 2016 وأرفق لك نسخة تعمل على 2003 أو أخبرنى كيف HideUnHide.mdb

أخى ابا جودى محاولة أخرى بعد فكرة أستاذنا AlwaZeeR .. دا لو كنت فهمت .. الجزء العلوى منها مرتبط بإكسيل .. أما بخصوص دا صعب عليا حيث أن فى طريقة أخى أبو الكرم لا يوجد ربط بين التقريرين ولا أدرى إن كان التقرير العلوى سيأخذ بياناته من نفس الجدول أم من جدول آخر وإن كان من جدول آخر فهل يوجد ربط بينهما ولا كل واحد سارح فى كيمياءاته لا تنسى تغيير مسار Source Doc لجدول الإكسيل بما يناسبك Consumable MaterialTest.rar

لا تتعب نفسك اخوي ابو زاهر ما عندي برنامج اريد اعرف الرقم السر له انا فقط اريد التأكد هل هناك برامج فعلا تكشف كلمة سر لملف من نوع Accdb و Accde

تفضل جرب هذا التعديل barcode.rar

السلام عليكم احبتي الاستاذه الكرام الاستاذ الكبير الـعيدروس والاستاذ a.kawkab جبر الله بخاطركم دنيا وآخره ارجو منكم اعتبار كل رقم رحلة يخصص لها شيت خاص بها كما هو موضح بالملف المرفق 2. ياريت تطوير اداة الاستعلام بالمرفق ولكن كما واضح بالملف الذي الذي قدمه الاستاذ الـعيدروس مع خالص تقديري واحترامي لكما 101استعلام عن طريق الاسم (2).xls

شكرا لك

تفضل 🙂 هذا الاستعلام ، وبسبب ان عدد الحقول كثيرة اللي نرسلها للوحدة النمطية ، استعملت الطريقة الاولى 🙂 هكذا ننادي الوحدة النمطية: وهذه النتيجة: وهذه الوحدة النمطية: Public Function Add_All(ID As Long) As String On Error GoTo err_Add_All 'G1, R1, K1, G2, R2, K2, G3, R3, K3, G4, R4, K4, G5, R5, K5, G6, R6, K6, G7, R7, K7, G8, R8, K8, G9, R9, K9, G10, R10, K10 Dim rst As dao.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl1 Where ID=" & ID) If Nz(rst!G1, 0) < Nz(rst!R1, 0) * 0.3 Then Add_All = Nz(rst!K1, 0) ElseIf Nz(rst!G1, 0) < Nz(rst!T1, 0) Then Add_All = "K1" ElseIf Nz(rst!G2, 0) < Nz(rst!R2, 0) * 0.3 Then Add_All = Nz(rst!K2, 0) ElseIf Nz(rst!G2, 0) < Nz(rst!T2, 0) Then Add_All = "K2" ElseIf Nz(rst!G3, 0) < Nz(rst!R3, 0) * 0.3 Then Add_All = Nz(rst!K3, 0) ElseIf Nz(rst!G3, 0) < Nz(rst!T3, 0) Then Add_All = "K3" ElseIf Nz(rst!G4, 0) < Nz(rst!R4, 0) * 0.3 Then Add_All = Nz(rst!K4, 0) ElseIf Nz(rst!G4, 0) < Nz(rst!T4, 0) Then Add_All = "K4" ElseIf Nz(rst!G5, 0) < Nz(rst!R5, 0) * 0.3 Then Add_All = Nz(rst!K5, 0) ElseIf Nz(rst!G5, 0) < Nz(rst!T5, 0) Then Add_All = "K5" ElseIf Nz(rst!G6, 0) < Nz(rst!R6, 0) * 0.3 Then Add_All = Nz(rst!K6, 0) ElseIf Nz(rst!G6, 0) < Nz(rst!T6, 0) Then Add_All = "K6" ElseIf Nz(rst!G7, 0) < Nz(rst!R7, 0) * 0.3 Then Add_All = Nz(rst!K7, 0) ElseIf Nz(rst!G7, 0) < Nz(rst!T7, 0) Then Add_All = "K7" ElseIf Nz(rst!G8, 0) < Nz(rst!R8, 0) * 0.3 Then Add_All = Nz(rst!K8, 0) ElseIf Nz(rst!G8, 0) < Nz(rst!T8, 0) Then Add_All = "K8" ElseIf Nz(rst!G9, 0) < Nz(rst!R9, 0) * 0.3 Then Add_All = Nz(rst!K9, 0) ElseIf Nz(rst!G9, 0) < Nz(rst!T9, 0) Then Add_All = "K9" ElseIf Nz(rst!G10, 0) < Nz(rst!R10, 0) * 0.3 Then Add_All = Nz(rst!K10, 0) ElseIf Nz(rst!G10, 0) < Nz(rst!T10, 0) Then Add_All = "K10" Else Add_All = "OK" End If Exit_Add_All: rst.Close: Set rst = Nothing Exit Function err_Add_All: If Err.Number = 3265 Then 'No field Add_All = "" Resume Exit_Add_All Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function جعفر 1136.D3.accdb.zip

و لك بالمثل إن شاء الله أخي

تفضل يمكنك استخدام هذه المعادلة =IF(G7="","",VLOOKUP(G7,$A$1:$B$150,2,0)) تغيير الرقم 1لنص.xlsx

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

من المفترض بيكون الكميه المشتراه ناقص الكميه المباعه

حبيبي أبا جودي بما ان الاسطر تضاف برمجيا فيجب إبقاء بعض هامش الصفحة من الأسفل عند المعاينة تظهر الورقة طبيعية لكن عند الطباعة يتجاوز حجم الورقة فيعطي صفحات متعددة ولا يتم طباعة البيانات انظر المرفق اطبع ووافني بالنتيجة Consumable Material Check List (30).rar

او هكذا يستبدل الملف ماتم سابقاً Private Sub Copy_Filtr(wb As Workbook, ws As Worksheet, Rng As Range, Optional sFile As String) Dim Pth, My_Pth Dim N_Book As Workbook Pth = ActiveWorkbook.Path & Application.PathSeparator My_Pth = Pth & sFile Set N_Book = Workbooks.Add wb.Sheets(ws.Name).Range(Rng.Address).Copy With N_Book With .Sheets(1) .Range("a1").PasteSpecial (xlPasteAll) .UsedRange.Columns.AutoFit End With Application.DisplayAlerts = False .SaveAs FileName:=My_Pth & ".xlsx" .Close Application.DisplayAlerts = True End With End Sub Sub My_Fl() With ActiveWorkbook.ActiveSheet Dim lRow, Cl, On_R Cl = Split(.UsedRange.Address, "$")(3) On_R = Split(.UsedRange.Address, "$")(1) & "1:": lRow = Split(.UsedRange.Address, "$")(4) With .Range(On_R & Cl & lRow) Copy_Filtr ActiveWorkbook, ActiveSheet, .SpecialCells(xlCellTypeVisible), "My_Filtr3" End With End With End Sub

من روائع القدر أن يضع الله في دربك من يُنيرون لك الطريق، فهؤلاء وحدهم من يستحقون الشكر والامتنان نعم هو كده تمام شكرا استاذ سليم شكرا استاذ حسين

حرب هذا الماكرو Sub RAND_NUM() Dim i%, k%, M%, Y Dim OBJ As Object Range("A5", Range("A4").End(4)).ClearContents Set OBJ = CreateObject("System.Collections.Sortedlist") For i = 1 To [c2] Randomize Y = Rnd() OBJ.Add Y, i Next M = 5 For k = 0 To OBJ.Count - 1 Cells(M, 1) = OBJ.IndexOfValue(k + 1) + 1 M = M + 1 Next End Sub الملف مرفق Rand_numbers.xlsm

شوف هذا Dim db As DAO.Database Dim rs As Recordset Set db = CurrentDb Set rs = db.OpenRecordset("t2") If DCount("*", "t2", "[nume]='" & Me.nume & "'" & "AND [xdate]=#" & Format(Me.xdate, "yyyy/mm/dd") & "#") > 0 Then MsgBox " الاسم مكرر ", vbExclamation, " : خطــــــــأ " Exit Sub Else rs.AddNew rs!sr = Me.sr rs!xdate = Me.xdate rs!nume = Me.nume rs!xpart = Me.part rs.Update rs.Close db.Close MsgBox " تم الترحيل بنجاح ", vbInformation, " : رسالة " End If عدم التكرار (1).accdb

تفضل اخي 1.xlsm

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

لانك عامل إيقاف لاهم شيء في الكود يعتمد على كم سطر تريد اظهار في الصفحة Consumable Material Check List waz (1).accdb

بارك الله فيك استاذي الفاضل

تأخرت لأني كنت ابحث عن الموضوع 🙂 تفضل ، مادام واجهة ، فالامر سهل 🙂 جعفر

أخى abo3aesha_2014 إذا كنت تقصد نسخ قواعد بيانات أكسيس فإليك هذا الموضوع أما إذا كنت تقصد نسخ ملفات فأخبرنا بذلك

اخر سجل hrk_sh = Nz(DLast("Price", "HRR", "Nwaha='11'"), 0) اول سجل hrk_sh = Nz(First("Price", "HRR", "Nwaha='11'"), 0)

السلام عليكم تم تبديل المعادلات في الملف المرفق... بن علية حاجي ترحيل بيانات من شيت رئيسي الي شيت آخر ( بمعادلات او اكواد ) المهم 1النتيجة - ا-بن عليه.xls

السلام عليكم بن علية حاجي ترحيل بيانات من شيت رئيسي الي شيت آخر ( بمعادلات او اكواد ) المهم 1النتيجة.xls

بعد اذن الاخ علي هذا الكود Option Explicit Sub get_data() Rem ====>> Created By Salim Hasbaya On 2/11/2019 Dim Sh1 As Worksheet, Sh2 As Worksheet Dim tabL1 As Range Dim i%, Ro%, x% Set Sh1 = Sheets("Sheet1") Set Sh2 = Sheets("Sheet2") Set tabL1 = Sh1.Range("A1").CurrentRegion Sh2.Cells(9, 3).Resize(100, 500).ClearContents Ro = tabL1.Rows.Count For i = 3 To 95 Step 3 tabL1.AutoFilter 1, Sh2.Cells(5, i) x = tabL1.SpecialCells(12).Count If x > 4 Then tabL1.Offset(1).Resize(Ro - 1) _ .SpecialCells(12).Offset(, 1).Resize(, 3).Copy _ Sh2.Cells(9, i) End If Next i If Sh1.AutoFilterMode Then Sh1.ShowAllData: tabL1.AutoFilter End If End Sub الملف مرفق tarhil.xlsm

ايه رأيك يا استاذى الجليل ومعلمى القدير الاستاذ @SEMO.Pa3x أن يتم إرسال ذلك اولا للعميل بدلا من ملف VBS HWND.zip

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

الدرس الخامس: استعمال الرموز إن استعمال الرموز و الأحرف لها دور كبير و لا يمكن الإستغناء عليه في جميع لغات البرمجة. و يختلف دور الرموز حسب موقعها في الكود و سنحاول ذكر ما نستطيع ذكره في هذا الدرس و أتمنى من الإخوة أن يكملوا ما عجزت عن ذكره. الفاصلة , تستخدم الفاصلة بشكل واسع في اكواد VBA فمثلا نورد هنا بعض استخدماتها على سبيل المثال لا للحصر: تستخدم للفصل بين قيم دالة تتطلب ادراج عدة قيم مثال: exm=DFirst(Expr, Domain, Criteria) للفصل بين المتغييرات عند تعريفها مثال: Dim a,b,c As Integer الاقواس الهلالية ( ) تستخدم الاقواس الهلالية في فيجول بيسك في الاماكن التالية : -عند كتابة الاكواد. -عند بداية كتابة اجراء معين او دالة ما. -في العمليات الحسابية. مثال: Function Example (exm As Boolean) D=(e-f)*g moy=(2+3+4)/3 الفاصلة المنقوطة ; تستخدم الفارزة المنقوطة في بعض من دوال اكسس و بالتحديد في منشأ التعابير علامتي الاقتباس " " تستخدم علامتي الاقتباس بشكل رئيسي لحصر النصوص بداخلها و بالتالي سوف يفهم البرنامج ان ما هو موجود بين علامتي الاقتباس هو نص و يتعامل معه عل هذا الاساس. مثال: Text0="منتدى أوفيسنا" علامة الاقتباس المفردة ' تستخدم علامة الاقتباس المفردة ' لتوضيح ما بعدها هو شرح و ليس عبارة برمجية مثال: ' A = Text0.BackColor الاقواس المربعة [] الاقواس المربعة ايضاً حالها حال الرموز السابقة لها استخداماتها المحددة و تتمثل استخدماتها في توضيح ان المتغييرات المحصورة بين قوسين مربعين انما هي اسماء لجدول او نموذج او استعلام او عناصر داخل تلك النماذج او حقل ضمن الجداول و الاستعلامات و تستخدم في منشأ التعابير و كودات ال(VBA) على حدٍ سواء و في بعض الاحيان يمكن الاستغناء عنها اي ان نذكر العناصر السابقة بدون حصرها بين قوسين مثال: Forms![form1].[Text0] = "ممكلة الاكسس و الوورد" علامة التعجب ! تستخدم علامة التعجب على حد علمي استخدام وحيد و هو موضح في مثال: Forms![form1].[Text0] = "ممكلة الاكسس و الوورد" و المثال السابق يوضح ان علامة التعجب توضح ان العنصر الذي بعدها هو احد النماذج الموجود في قاعدة البيانات كما انها تكون مسبوقة بالكملة Forms للتدليل على ان ما بعد علامة التعجب هو عنصر من نوع نموذج و هي تستخدم كما اسلفنا في منشأ التعابير و كودات ال(VBA) الرمز & و هي اختصار لكلمة AND باللغة الانكليزية و هنا تستخدم لربط سلسلتين نصيتين او اكثر مثال: Text0 = "مملكة " & "الاكسس " & "و " & "الوورد" علامة = و هي تقوم بإسناد قيمة ما بعدها للمتغيير الموجود قبلها سواءاً كانت تلك القيمة رقم او معادلة رياضية او قيمة منطقية او سلسلة نصية .. الخ مثال: A=b+c علامة النقطة . و هي مهمة جدا في البرمجة. فعند ذكر اسم اي عنصر من عناصر قاعدة البيانات و الحاق اسم العنصر بعلامة النقطة (.) فسوف تظهر قائمة بخصائص ذلك العنصر و الاوامر التي يتعامل معها ذلك العنصر . مثال: Text0.Text = "احمد الحربي" علامة الشارحة السفلية _ تستخدم هذه العلامة للفصل بين اسم العنصر و الحدث المرتبط به مثال: Private Sub Command2_Click() علامة # تستعمل هذه العلامة لتحول سلسلة رقمية الى تاريخ مثال : Text0 = #30/1/2017# + عملية الجمع - تستعمل لعمية الطرح * تستعمل لعملية الضرب / تستعمل لعملية القسمة ^ تستعمل لعملية الأس مثال: text1=2+3 text2=10-6 text3=70/5 text4=4*23 text5=6^4

شكرا أخي صالح في الواقع انا لم ادرس البرمجة (نعم مادة الفورتران في بداية دراستي الجامعية) ، ولم ادخل في تدريب ، وحتى ما عندي رخصة سواقة الحاسوب وانما كل الذي عندي من تجارب عملية ، لذلك ترى الفرق واضح من طريقة عرضك للموضوع ، وطريقة عرضي جعفر

الدرس الثالث: الدالة Select Case تشبه الدالة Select Case إلى حد كبير الدالة If و لكنها تختلف عنها بالتعدد أي أنها تكون في الشروط المتعددة. طريقة الاستعمال: الصيغة الأولى: Select Case Expression Case Expression_1 Statement_1 Case Expression_2 Statement_2 Case Expression_n Statement_n End Select تقوم الدالة Select Case باختبار حالة الكائن أو المتغير Expression و مقارنتها أو مطابقتها مع الحالات الموجودة بداخلها. و عند تحقق الشرط مع إحدى الحالات يقوم البرنامج بتنفيذ التعليمة Statement التابعة لهذه الحالة. و عند عدم مطابقة الكائن أو المتغير لجميع الحالات فإن البرنامج لا يعطينا أي نتيجة. مثال1: كتابة الأرقام من 1 إلى 4 بالحروف Select Case me.le_nombre Case 1 Me.y = "واحد" Case 2 Me.y = "إثنان" Case 3 Me.y = "ثلاثة" Case 4 Me.y = "أربعة" End Select أضفنا مربع نص اسمه le_nombre لإدخال الأرقام و مربع نص اسمه y من أجل ظهور النتيجة. الصيغة الثانية: Select Case Expression Case Expression_1 Statement_1 Case Expression_2 Statement_2 Case Expression_n Statement_n Case Else Other_statement End Select في هذه الصيغة عند عدم تحقق الشرط مع جميع الحالات يتم إرجاع التعليمة الإستثنائية Other_statement مثال2: نفس المثال الأول Select Case me.le_nombre Case 1 Me.y = "واحد" Case 2 Me.y = "إثنان" Case 3 Me.y = "ثلاثة" Case 4 Me.y = "أربعة" Case Else me.y = "هذا الرقم غير موجود" End Select هذا عندما نضيف أي رقم يختلف عن 1 أو 2 أو 3 أو 4 يطبع لنا "هذا الرقم غير موجود" مثال 3: برنامج كتابة ملاحظات التلاميذ حسب الدرجة Select Case Me.Degre Case 0 To 30 Me.y = "ضعيف" Case 30 To 49 Me.y = "دون الوسط" Case 50 To 69 Me.y = "مقبول" Case 70 To 89 Me.y = "جيد جدا" Case 90 To 100 Me.y = "ممتاز" Case Else Me.y = "هذه الدرجة خاطئة" End Select هنا إستخدمنا To معناه إلى مثلا: من 0 إلى 30

الــدرس الثاني : الجملة الشرطية ( IF ) تعتبر الجملة IF من أشهر الجمل الشرطية و أكثرها استعمالا في جميع لغات البرمجة ولها عدة صيغ كلها تبدأ بــIf و تنتهى بكلمة End If ما عدى صيغة واحدة. وتستخدم الجملة IF لتنفيذ عمليات معينة حسب شرط محدد, يعني إذا تحقق الشرط ينفذ و إلا فلا. طرق استعمال الجملة ((if: 1- الصيغة ( If –Then ) : - وصيغتها العامة : IF condition THEN statements - ومعنى هذه الصيغة : انه اذا تحقق الشرط (condition ) فسيتم تنفيذ الامر ( statements ) مثال : " مسن" IF age >=65 THEN category = 2- الصيغة ( If – Then – End If ) : صيغتها العامة : IF condition THEN statements1 Statements2 END IF تقوم هذه الصيغة بتنفيذ مجموعة من الاوامر اذا تحقق الشرط (Condition) بدلا من تنفيذ امر واحد. مثال : If age >= 25 Then category ="شباب" travail ="السن مقبول" End if 3- الصيغة ( If – Then – Else ) : صيغتها العامة : If condition Then statements1(التعليمات المنفذة في حال تحقق الشرط ) Else statements2(التعليمات المنفذة في حال عدم تحقق الشرط) End If - هذه الصيغة تنفذ مجموعة الأوامر (statements1 ) عندما يتحقق الشرط (condition ) و عندما لا يتحقق الشرط فإنها تنفذ مجموعة الأوامر (Statements2). مثال : If grade >= 50 Then Text1 ="ناجح" Else Text1 ="راسب" End If 4- الصيغة ( If – Then –ElseIf ) : - صيغتها العامة : If condition1 Then statements1( التعليمات المنفذة في حال تحقق الشرط الأول) ELSEIF condition2 THEN statements2(التعليمات المنفذة في حال عدم تحقق الشرط الأول و تحقق الشرط الثاني) ELSE statements2(التعليمات المنفذة في حال عدم تحقق جميع الشروط السابقة) End If مثال : If grade >= 90 Then Text1 ="ممتاز" ElseIf grade >= 80 Then Text1 ="جيد جدا" ElseIf grade >= 70 Then Text1 ="جيد" ElseIf grade >= 60 Then Text1 ="مقبول" Else Text1 ="راسب" End If ملاحظات: - في الصيغة الأخيرة ( If – Then –ElseIf ) اذا تحقق احد الشروط فان البرنامج ينفذ العملية ثم يذهب الى نهاية الجملة و لا يتحقق من الشروط الباقية. - في حالة أردنا إستعمال شرطين معا أو أكثر نستعمل العبارة And. - في حالة أردنا تحقق أحد شرطين ليتم تنفيذ العملية نستعمل Or

ملاحظاتك ممتاز و في محلها و متممة للمعنى ربما هنا من يستعمل اللغة العربية في تعريف المتغير بهذا الشكل : Dim الرقم_الأول As Integer ملاحظة: - القيمه الإفتراضية للمتغيرات النصيه هي فراغ " " - أما القيمه الإفتراضية للمتغيرات الرقميه هي صفر 0

أيضا يستحسن كتابة أسماء المتغيرات باللغة اللاتينية من أجل تسهيل التعامل معها و عدم حدوث مشاكل فيما بعد

طرق استعمالها: 1. اذا اردنا استعمال المتغير في الحدث / الوحدة النمطية فقط (يعني لا يمكن اخذ قيمتها من نماذج/تقارير/استعلامات/وحدات نمطية اخرى) ، فنستخدم: Dim UserName as string او Private UserName as string ويجب ان نستخدم Dim لكل حدث في النموذج/التقرير ، اي نعيد كتابته لكل حدث ، بينما يمكننا ان نضع Dim / Private مرة واحدة في اعلى الصفحة ، ولا تكون داخل اي حدث ، هكذا Option Compare Database Private User_Name As String 2. بينما اذا اردنا ان تكون القيمة متوفرة في جميع كائنات البرنامج ، فنستخدم التالي في وحدة نمطية (حتى ولو كانت وحدة نمطية فارغة): Public UserName as string مثال هذا ، عندما تستعمل نموذج المستخدمين ، ثم تريد الاحتفاظ باسم المستخدم في الكود ، فكل الذي تعمله هو: UserName = "jjafferr" ثم من اي مكان في البرنامج تستطيع ان تستعمل هذا المتغير UserName ، مثلا: User_Prevliage = iif(UserName = "jjafferr" , "Admin", "User") . ويمكننا ان نجعل الكود لا يعمل إلا بتعريف المتغير ، وفي الواقع هذه صعبة في البداية ، ولكن في النهاية سيكون برنامجك افضل ، وهكذا نجعل الكود يفرض علينا استعمال المعرف: . . واهمية هذه الخطوة هي عندما تريد ان تحفظ البرنامج لاحقا بصيغة mde او accde ، فيجب عليك ان: . واذا كانت المتغيرات في الكود معرّفة ، فلن تحصل على اخطاء في التحويل جعفر

على بركة الله نبدأ أول درس و ننتظر ملاحظاتكم حول أي شيء نسيته و هو متعلق بهذا الدرس أو أي معلومة أخطأت بها: الــدرس الأول : المتغيرات تعتبر المتغيرات النواة الأساسية أو حجر الأساس بالنسبة لكل برنامج في أي لغة برمجة كانت. يعني قبل البدأ يجب أن تقوم بتعريف المتغيرات التي تحتاجها و تحدد نوعها قبل كل شيء. 11- أنواع المتغيرت: هناك العديد من أنواع المتغيرات و كل نوع يخصص له حجم معين في الذاكرة. سوف نقوم بإضافة شرح جميع أنواع المتغيرات و الحجم الذي يأخذه كل نوع من الذاكرة: String: نص يتسع المتغير النصي إلى 2 جيجا بايت و كل حرف يشغل 1 بايت Boolean: ياخذ نوعين من القيم True و False (طوله 2 بيت ) Byte: بايت يكون رقم بين 0 من 255 (طوله 1 بايت) Integer : عدد صحيح (طوله 2 بيت ) قيمته من 32768- إلى 32767 Long : عدد صحيح طويل (طوله 4 بيت) قيمته من 2,147,483,648- إلى 2.147.483.647 Signal: عدد عشري (طوله 4 بيت) قيمته من 3.402823x1038- إلى 1.401298x10-45- للقيم السالبة و من 1.401298x10-45 إلى 3.402823x1038 للقيم الموجبة Currency: عملة (طوله 8 بيت) قيمته من 922،337،203،685،477.5808- إلى 922،337،203،685،477.5807 Double : مزدوج عدد عشري (طوله 8 بيت) قيمته من 1.79769313486231x10308- إلى 4.94065645841247x10-324- للقيم السالبة. و من 4.94065645841247x10-324 إلى 1.79769313486232x10308 للقيم الموجبة Date: نوع البيانات تكون على شكل تاريخ (طوله 8 بيت) يبدأ تاريخ vba من 1/1/100 حتى 31/12/9999 Object : لتخزين الكائنات التي تحتوي على خصائص و وظائف و يتم تعيينه بجملة set ويشغل في الذاكرة 4 بايت أو حسب خصائص و وظائف الكائن المحدد. و سوف نخصص درس لعرض أنواع الكائنات. Variant : لتخزين كل الأنواع السابقة ويمكن تخزين المصفوفات بداخله أيضاً 2- طريقة الإعلان عن المتغيرات: الإعلان عن متغير يعني حجز مكان في ذاكرة الكمبيوتر باسم هذا المتغير و يحدد حجمه حسب نوع المتغير. و يتم تعريف المتغير أو الإعلان عنه بواسطة العبارة DIM . مثال: Dim A as Integer للإعلان عن أكثر من متغير: Dim a,b as integer للإعلان عن أكثرمن متغير لأنواع مختلفة في نفس السطر: Dim A As Double, B As Integer 3- ملاحظات: - - يفضل الإعلان عن نوع المتغير لزيادة سرعة التعامل معه . - - المتغيرات التي لم تحدد نوعها يعمل فيجول بيسك علي الإعلان عنها تلقائيا من النوع Variant وهو أبطأ أنواع المتغيرات . - - بالنسبة للإعلان عن أكثر من متغير من نفس النوع بالطريقة التالي: Dim a,b as integer هنا b فقط من النوع integer أما a فهو في هذه الحالة يعتبر من النوع Variant يجب أن يتم التعريف بهذا الشكل: Dim a integer,b as integer أو Dim a as Integer Dim b as Integer 4- شروط تسمية المتغيرات: - - اسم المتغير يجب أن يبتدأ بحرف . - - يمكن استعمال الحروف التي تلي الحرف الأول رقم أو حرف أو الإثنين معا. - - لا يجب أن تكون هناك فراغات بين أسماء المتغير و يمكن استعمال الشكل التالي: id_user - - يجب عدم استعمال نقطة أو رمز خاص مثل ( ؟ ، * ، ) ، ( ، /......... إلخ ) ولكن يمكن استخدام الشرطة السفلية ( _ ) - - أن لا يكون اسم المتغير من الكلمات المحجوزة في الأكسس.

السلام عليكم الاخ الحبيب/ محمدي ----حفظه الله اكرمك الله واثابك بمثل ما دعوت لي اضعاف مضاعفة تقبل تحياتي وشكري ======================= الاخ الحبيب/ ابو اسامة العينبوسي----حفظه الله سرني مرورك اكرمك الله تقبل تحياتي وشكري ======================= الاخ الفاضل/ yahia----حفظه الله في المرفق ستجد ما تريد تقبل تحياتي وشكري ======================= الاخ الفاضل/ عادل----حفظه الله وانت بالف خير تقبل تحياتي وشكري ======================= الاخ الفاضل/ safwat----حفظه الله في المرفق ستجد ما تريد ======================= الاخ الفاضل/ قصي----حفظه الله الله يكرمك اخي الصفحة الرئيسية هي موجودة في فايل معين وبرفقتها ملفات اكسل معينة( هما دول الملفات التي يتم فيها البحث) ======================================== الاخ الفاضل/ engineer.salah----حفظه الله سرني مرورك اكرمك الله تقبل تحياتي وشكري ======================================== في الصفحة الرئيسية اضفنا جدول يتم من خلاله التحكم في اعدادات البحث الملفات والاوراق ونطاق البحث تفضلوا المرفق بحث بفورم في عدة ملفات.rar