Leaderboard

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

وعليكم السلام تفضل تضليل أيام الجمعة والسبت من كل شهر.xlsm

اتفضل اخى خيرى الملف بعد التعديل عل المعادلة تضليل أيام الجمعة والسبت من كل شهر.xlsm

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

السلام عليكم 🙂 في الماضي كان عندنا معيار واحد فقط (التاريخ) ، بينما الآن اصبح عندنا معيارين (التاريخ و الادارة) ، وهذا اخذ مني اكثر من يومين للوصول اليه !! على العموم ، نظّفت الكود بطريقة اخرى ، والعرض اصبح الآن يأخذ الصفحة كاملة ، وعلى اساسه يعمل عرض الحقول 🙂 وهذا الكود كاملا: Private Sub Report_Open(Cancel As Integer) Dim ctrl As Control Dim A As Integer Dim Empty_Cells As Integer Dim Full_Cells As Integer Dim W As Integer Dim myWhere As String Dim rpt_width As Integer Dim Full_Date As Date Dim D As Integer Dim Y As Integer Dim M As Integer 'W = 2200 / 4 'field width Empty_Cells = 0 Full_Cells = 0 'the name rpt_width = 0 Y = Forms!Report!iYear 'year M = Forms!Report!iMonth 'month 'lets fit/expand the controld based on the avaible width 'how many Full_Cells For D = 1 To 31 Full_Date = DateSerial(Y, M, D) myWhere = "[edara]='" & Forms!Report!cmd_edara_N & "'" myWhere = myWhere & " And " myWhere = myWhere & "[zeiara_date]=" & DateFormat(Full_Date) A = DCount("*", "zeara", myWhere) If A <> 0 Then Full_Cells = Full_Cells + 1 End If Next D W = Me.Width - (Me.Printer.LeftMargin + Me.Printer.RightMargin + Me("mogh_name").Width) W = W / (Full_Cells - 1) For D = 1 To 31 Full_Date = DateSerial(Y, M, D) 'the field Names from the Crosstab query 'check if this field exists int the table myWhere = "[edara]='" & Forms!Report!cmd_edara_N & "'" myWhere = myWhere & " And " myWhere = myWhere & "[zeiara_date]=" & DateFormat(Full_Date) A = DCount("*", "zeara", myWhere) If A = 0 Then 'field dose not exist Me("txt_" & D).Width = 0 'trim field size to Zero Me("txt_" & D).Visible = False 'make the field invisible Me("txt_" & D).ControlSource = "" 'remove the Control Source Me("lbl_" & D).Width = 0 'trim label size to Zero Me("lbl_" & D).Visible = False 'make the label invisible Empty_Cells = Empty_Cells + 1 'Debug.Print "Off " & Me("txt_" & D).Name & vbTab & "D:" & D & vbTab & "Full:" & Full_Date & vbTab & "A:" & A Else 'field exists Me("txt_" & D).Width = 1 * W 'set the field width Me("txt_" & D).Visible = True 'make the field visible Me("txt_" & D).ControlSource = Full_Date Me("lbl_" & D).Width = 1 * W 'set the label width Me("lbl_" & D).Visible = True 'make the label visible Me("lbl_" & D).Caption = D & "/" & M 'give the label, a caption Full_Cells = Full_Cells + 1 rpt_width = rpt_width + Me("txt_" & D).Width 'add the width 'Debug.Print "ON " & Me("txt_" & D).Name & vbTab & "D:" & D & vbTab & "Full:" & Full_Date & vbTab & "A:" & A End If Next D Me.Width = rpt_width + Me("mogh_name").Width 'the final Report width End Sub جعفر 1030.rpt_Monthly_Crosstaby.mdb

السلام عليكم, في السابق كنت استخدم خطوط معينة في برامجي وعند اعطاء البرنامج للعميل لاتظهر الخطوط التي قمت باستخدامها بل يظهر بمكانها الخط ( Arial ) وهذه مُشكلة. كت في وقتها الجأ الى ان اضع الخط بجانب قاعدة البيانات وفي داخل قاعدة البيانات اقوم بعمل تحقق لمجلد Fonts والبحث عن الخط في بداية تشغيل القاعدة, فإن لم يجده يعي رسالة للعميل بان الط مفقود وعليه ان يقوم بتثبيته من جانب البرنامج. بحثت طويلاً في الانترنت عن تثبيت خط من الاكسس فقط بدون مساعدة عامل خارجي ولكن لم اصل لنتيجة. اليوم بحمد الله قمت بحل المشكلة بإستخدام ( Visual .NET ) قمت بكتابة اداة بسيطة وظيفتها تثبيت الخط. يتم تمرير براميتر لها وهي بدورها ستقوم بتثبيته الدوال المستخدمة: AddFontResource CreateScalableFontResource ShellExecuteA للمزيد من المعلومات ، اضغط على اسم الدالة ارفقت لكم المصادر من MSDN شرح بسيط لمن لم يعرف ماذا اقصد بتثبيت الخط واستخدام الخط وانه لن يظهر في حال كان العميل لا يملكه. قمت بارفاق قاعدة بيانات لكم كـ مثال للشرح مع الخط المستخدم مع الاداة. شرح الاستعمال: يجب ان تكون الاداة ( SEMO_RegisterFont.exe ) هي والخط الذي سوف تستخدمه بجانب قاعدة البيانات. افتح برنامجك وضع فيه هذا الاجراء. Sub RegisterFont(nFont) Dim strExe As String Dim strArg As String strExe = CurrentProject.Path & "\" & "SEMO_RegisterFont.exe" strArg = "/SEMO/" & nFont ShellExecute 0, "runas", strExe, strArg, vbNullString, SW_SHOWNORMAL End Sub في الاستدعاء اي في الحدث Form_Current RegisterFont "DroidSansArabic.ttf" حيث ان الـ DroidSansArabic.ttf هو اسم الخط الذي قمنا بوضعه بجانب قاعدة البيانات ملاحظة مهمة جدا: في حال كان اسم الخط يتكون من اكثر من كلمة مثل ( Droid Sans Arabic.ttf ) قم بحذف المسافات بين كلمة واخرى بحيث يصبح ( DroidSansArabic.tts ) وستعمل قاعدة البيانات التي قمت بتصميمها بشكل رائع وبالخطوط التي قمت انت بأختيارها بدون الخوف من مشكلة عدم توفر الخطوط في جهاز العميل. الشرح حصري للمنتدى وغير موجود في الانترنت. لا تشكرني الا اذا وجدت انني استحق ذلك. تم بحمد الله حسنين RegisterFont_SEMO_Pa3x.rar

بحث بالفورم فى الكود والاسم وتعديل البيانات الفيديو الصور بحث بالكود بحث بالاسم فى انتظار طلباتكم فى الملف قبل الرفع

السلام عليكم وصلتنا أكثر من شكوي بشأن عدم تفعيل الترقيات الالية تمت مراجعة الأمر و حاليا سيتم التفعيل باذن الله مع أول دخول أو مع اضافة أول مشاركة الترقيات الالية الحالية كالتالي: عند التسجيل: عضو جديد عند بلوغ 50 مشاركة : عضو عند بلوغ 100مشاركة : عضو مميز عند بلوغ 500 مشاركة : عضو فضي عند بلوغ 1000 مشاركة : عضو ذهبي عند بلوغ 2000 مشاركة: عضو ماسي و يستثني من الترقيات الالية مجموعات الخبراء و فريق الموقع الحالي و السابق و العضوية الشرفية

بحث بالفورم فى سبع عواميد بالاكسل الفيديو الصور بحث بالمسلسل تكبير الصورة معاينة الأبعاد الأصلية. بحث بالاسم تكبير الصورة معاينة الأبعاد الأصلية. بحث بتاريخ الميلاد تكبير الصورة معاينة الأبعاد الأصلية. باقى البحث فى الفيديو بحث بالكود وبحث فى المحافظة وبحث فى الديانة وبحث فى النوع

كل الشكر والتقدير للسادة الافاضل فريق الموقع والسادة الخبراء وجميع الاعضاء الجدد والقدماء على مساعدتهم لى فى حل كل المشاكل التى تقابلنى اثناء انشاء اى برنامج وعدم تاخرهم على اجابة اسالتى سواء بمثال او بكود ولذلك وجب شكرهم وشكرمن قام بعمل هذا المنتدى الرائع الذى نجد بة كل مانحتاج الية من اسئلة متنوعة وحلول رائعة خالص الشكر

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

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

السلام عليكم 🙂 اخي @essam rabea كنت خبير ، والآن اهلا وسهلا بك خبيرا معتمدا بيننا 🙂 جعفر

أرفق اليكم نموذج بحث متعدد النتائج .. به وحدة نمطية بسيطة لتوحديد الأحرف المتشابهة وإزالة المسافات وتجاهل الهمزات والتشكيل ..عسى يجد من ينتفع به.وتجدر الإشارة أن أغلبه من أفكار رواد هذا المنتدى العزيز. أعزكم الله .. تحياتى Officna.rar

أترككم مع التجربـة منتظر رأيك يا دكتور @حلبي ولى عودة بعد التجربة text Reader.mdb

السلام عليكم ورحمة الله استخدم هذا الكود و قم بتغيير اسم ملف الصور الى Pics و اجعل ملف الاكسل خارج ملف الصور و ليس داخله Sub AddPics() Dim ws As Worksheet, C As Range Dim EmpName As String, T As String, Dpath As String Dim pic As Object Application.ScreenUpdating = False Set ws = Sheets("ورقة1") For Each pic In ws.Pictures pic.Delete Next pic On Error Resume Next Set C = ws.Range("B2:B5") EmpName = ws.Range("A5").Value Dpath = ActiveWorkbook.Path & "\" myDir = Dpath & "Pics" & "\" T = ".jpg" On Error Resume Next ws.Shapes.AddPicture Filename:=myDir & EmpName & T, _ linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=C.Left, _ Top:=C.Top, Width:=C.Width, Height:=C.Height Application.ScreenUpdating = True End Sub

تحويل اللغة تلقائيآ من العربية الى الانكليزية أو العكس بعد الخروج من مربع النص راجيآ القبول و الدعاء لي في ظهر الغيب .. تغيير اللغة تلقائيآ.accdb

السلام عليكم 🙂 وبعد ملاحقة الرابط الى آخر الى آخر الى آخر الى آخر الى آخر الى آخر الى ... ، ومحاربة مضاد الفيروسات على كمبيوتري مع هذه الصفحات والتي تحاول زرع برامج خبيثة عليه ، اليكم الرابط الاخير لتحميل البرنامج: https://www.file-up.org/azot1x4brsec جعفر ملاحظة: بسبب صعوبة حصول الاعضاء على البرنامج من رابط الرفع ، تم اضافة المرفق الى الموضوع الاصل 🙂

كثر الحديث والطلب عن هذا الموضوع (استخراج الارقام أو الأحرف او الكلمات من نص) لذلك قمت بتحميل هذا الملف الذي عسى ان يستفيد منه اكبر عدد ممكن من الاعضاء الملف يحتوي على دالّة معرفة Option Explicit Function Salim_Single_Match(aString As String, my_expression As String, n%) As Variant Dim RegEx As New VBScript_RegExp_10.RegExp Dim NowArray() As String Dim Match, matches As Object Dim x%, cnt% With RegEx .Pattern = my_expression .Global = True .IgnoreCase = True End With On Error Resume Next Set matches = RegEx.Execute(aString) x = matches.Count If x = 0 Then Error.Clear Salim_Single_Match = "No Match": Exit Function End If ReDim NowArray(x - 1) For Each Match In matches NowArray(cnt) = Match.Value cnt = cnt + 1 Next If n > cnt Then n = cnt Salim_Single_Match = NowArray(n - 1) End Function salim_UDF_Formula.xlsm

____ _ __ _ ____ |####`--|#|---|##|---|#|--'##|#| _ |____,--|#|---|##|---|#|--.__|_| _|#)_____________________________________,--’Mohammed_Essam'_=-. ((_____((___________officena___________,--------[JW](___(____(____(_==) _________ .--|##,----o o o o o o o__|/`---,-,-'=========`=+==. |##|_Y__,__.-._,__, __,-.___/ J \ .----. |##| |##| `-.|#|##|#|`===l##\ _\ |##| |_|__|_| \##`-"__,=======. |##| \__," '======' ☺ ممنوع النسخ يمكنك نسخ نموذج ازرار الانتقال الى اى قاعدة ووضعه نمو1ج فرعيا وسيعمل على الفور ان شاء الله navigation buttons.mdb

هذا برنامج الملاحظة1 وهو يرنامج صمم خصيصا لمساعدة الإدارات المدرسية في عمل حصص المراقبة على الامتحانات , والمساواة بين المعلمين بقدر الأمكان في حصص المراقبة التعليمات والشرح داخل الملف برنامج الملاحظة1.rar

عندنا قائمة (في العامود الاول ) لمجموعة اسماء لاشخاص ممكن ان تكون مكررة المطلوب اختيار عدد معين منها (تختاره بنفسك) ودون تكرار بطريقة عشوائية الكود Option Explicit '+++++++++++++++++++++++++++++ Sub choos_randomly() Dim i%, rd%, x%, _ k%, y%, Lr% Dim My_list As Object If ActiveSheet.Name <> "Salim" Then Exit Sub Set My_list = CreateObject("System.Collections.ArrayList") Lr = Cells(Rows.Count, 1).End(3).Row If Lr < 2 Then Exit Sub Range("c2", Range("c1").End(4)).ClearContents '=============================== If [g2] <= 0 Or Not IsNumeric([g2]) Then MsgBox "You Choose a NEGATIVE Number ,Or ZER0 or Empty CELL" & Chr(10) & _ "I Can't Help You", 1048640 Exit Sub Else [g2] = Int([g2]) End If '===================== With My_list For i = 2 To Lr If Not .Contains(Range("a" & i).Value) Then .Add Range("a" & i).Value End If Next y = .Count .Clear End With If [g2] > y Then MsgBox "You Choose an Impossible number" & Chr(10) & _ " Please Enter a Number <= than " & y, 1048640 [g2] = vbNullString Exit Sub End If '====================== k = 0 With My_list Do Until k = [g2] If k = y Then Exit Do x = (Lr) * Rnd: If x < 2 Then x = 2 If Not .Contains(Range("a" & x).Value) Then .Add Range("a" & x).Value k = k + 1 End If Loop Range("c2").Resize(.Count) _ = Application.Transpose(.toarray) .Clear End With End Sub الملف مرفق Choose N_Presons from _M.xlsm

السلام عليكم تفضل الملف به اضافة للكود تمنع اعطاء المراقب فترتان فى وقت واحد توزيع الارقام بطريقة عشوائية2.xlsm

انظر المرفق ...... ‫‫‫الموظفين-kan.rar

جرب وبالتوفيق text.mdb

اتفضل ابو حنين الملف لعله يقى بالغرض بحث بشرطين.xlsx

السلام عليكم نهنىء اخونا وحبيبنا محمد عصام ( ابو جودي ) اهلا وسهلا بك خبيرا معتمدا والف مبروك زادك الله علما ورفعة ونفع بك

السلام عليكم تفضل الحل في الملف المرفق بمعادلة مختلفة تماما عن السابقة... بن علية حاجي DAYS_CALCULATION_3.xlsx

السلام عليكم معادلة أخي الكريم سليم مختصرة في الملف المرفق... يمكن استعمال الدالة SUMPRODUCT بدلا من الدالة SUM (وفي هذه الحالة غير ضروري تأكيدها كمعادلة صفيف)... بن علية حاجي DAYS_CALCULATION_2.xlsx

تفضل-ولكن كا ن عليك من البداية رفع ملف تجنبا لإهدار الوقت وشرح لما تريد بالضبط فعليك بتغيير النطاق بالكود لما تريد Sub print_out() Sheets("Sheet1").Range("a2:g100").PrintOut End Sub

جرب هذا الملف DAYS_CALCULATION.xlsx

الافضل ارفاق ملف حتى يتم معرفة المطلوب بالضبط والتعديل عليه لكم تحياتي لاحظ الروابط التالية اضافة القرار كيفية توزيع درجات القرار اضافة درجات القرار

السلام عليكم تم التعديل على المعادلات في العمودين E و F... جرب المرفق لعل فيه ما تريد... بن علية حاجي توزيع نقود كما بالبنوك (1).rar

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

السلام عليكم الكود ببساطة يقوم بحذف كل الدوائر الحمراء ثم يعيد إدراجها حسب الشروط (مقارنة علامة الطالب بعلامة النهاية الصغرى) التي وضعتها في كل سطر خاص بـ "علامة الطالب" لكل شهادة وذلك باستعمال خاصية "التحقق من الصحة" Validation... والسبب، باعتقادي، على عدم ظهور الدوائر الحمراء في الشهادتين الأولى والثانية هو أنه قد تم إلغاء خاصية "التحقق من الصحة" في هاتين الشهادتين في السطر الخاص بـ "علامة الطالب"... لا يمكن التحقق من صحة كلامي إلا بإرفاق الملف المعني وليس بصورة من صفحة الشهادات... والله أعلى وأعلم بن علية حاجي

السلام عليكم جرب المرفق... بن علية حاجي حصص الاحتياط.xlsm

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه 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") . جعفر

برنامج المحاسبه الماليه برنامج محاسبي يصلح للشركات الصغيره و المتوسطه لا يحتاج البرنامج الي خبير حسابات يسهل التعامل مع البرنام الاصدار الاول البرنامج باللغه العربيه برنامج محاسبي مجاني مصصم بالاكسيس تسجيل قيود اليوميه بكل سهوله واعداد دفتر الاستاذ اعداد ميزان المراجعه اعداد قيود التسويه اعداد قائمه الدخل و الميزانيه العموميه اعداد قائمه التدفقات النقديه اعداد كافه التقارير المحاسبيه يمكن التعديل علي البرنامج و تطويره رابط التحميل http:// http://activeterium.com/BhBv برنامج+المحاسبة+المالية.rar

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

حتّى لا يضيع الــ Commend Button أو اذا قمت بتحديد نطاق من الخلايا (او حتى خلية واحدة) بعيداً عنه فأنه يتبعك اينما ذهبت بواسطة هذا الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim col%: col = Target.Columns.Count Dim lastcel As Range: Set lastcel = Target.Rows(1).Cells(col) Application.EnableEvents = False With Me.Shapes.Range(Array("SALIM_BTN")) .Left = lastcel.Left + lastcel.Columns.Width + 5 .Top = lastcel.Top .Width = 130 .Height = 28 End With Application.EnableEvents = True End Sub جرب هذا الملف Floting_Btn.xlsm

السلام عليكم 🙂 . 1. نعم ، بعمل مجموعة استعلامات تحديث ، استعلام لكل جدول (وقد نحتاج الى اكثر من استعلام للجدول) ، ولكن يعملون بحدث رز واحد ، 2. نعم ، ولكن هذا يعتمد على المعيار والتصفية ، ويمكنك تجربة هذا على حقل معين في الجدول ، قم بتغيير بيانات بعض الحقول الفارغة الى - ، وشوف النتيجة. نعم كلامك صحيح. سبق وان ناقشنا هذا الموضوع ، وبعمق ، فرجاء لا تأتي بأسماء اعضاء وتحرجهم ، والنتيجة ببساطة انك لن تجد لهم جواب في اسئلتك القادمة (وقد تم حذف اسم العضو من موضوعك اعلاه). مشكلتك الاساسية هي عدم ظهور كافة البيانات في الاستعلام (الاستعلام وبدون اي معايير) ، وذلك لأن العلاقة التي عملتها بين الجدولين لا تطلب جميع السجلات وبغض النظر من وجودها في الجدول الآخر او لا ، وقد قام الاخ كاسر @kaser906 مشكورا بتوضيح وتعديل الاستعلام في 3 ابريل ، اي قبل 8 ايام تقريبا ، وذلك في الموضوع والطريقة التي قام بها: بما ان ربطك للجدولين ظاهرا هكذا (علاقة الربط غير حقيقة الربط) ، ولكن حقيقة ، الربط بحقل "اسم الشهرة" و"المؤلف" ، لأنك مستخدم Lookup لحقل "المؤلف" ، فالحقول (في المربع الاحمر) التي لا توجد اسماء لها في الجدول الآخر ، لن تظهر في الاستعلام . وبالنقر المزدوج على خط العلاقة بين الجدولين ، تظهر لنا هذه النافذه ، والتي نختار منها جميع السجلات في الجدول Marj3 ، بغض النظر اذا كانت موجودة في الجدول الآخر او لا . والنتيجة تكون هكذا (لاحظ السهم تحت الرقم 1) . وعلى اساسه نرى جميع البيانات في الاستعلام . الى هنا وينتهي الذي قام به الاخ كاسر ، ولما نرى النتيجة في النموذج ، وبعد إضافة معيار البحث في الاستعلام ، ثم نبحث عن: "د" . ففي واقع الامر ، لم تكن عندك مشكلة في NULL ، وانما في عرض البيانات بطريقة صحيحة 🙂 جعفر 1029.نموذج بحث.accdb.zip

ارشحك مشرف وبقوة حتى لو جديد 😉 واستاذن اخي الغالي @محمد سلامة في ان يكون صدره متسع في مشاركتي لانها قد تخالف وجهة نظره انا هنا ساطرح وجهة نظري بعيد عن كل شي وبها خروج قليلا عن الموضوع وفي الاخير هي وجهة نظر شخصية انا صرت اشوف مشاركات بالمنتدي فيها تسويق اكثر من انها مشاركة مثل 1. مشاركة اخينا هنا فهو عرض ميزات وعرض صور فقط مع انه يوجد لمسات كويسة في البرنامج ؟ فهل ياترى لو تحول الموضوع هنا الى استفسار بكيف تم عمل الجزئية الفلانية سنجد الرد ؟ 2. اخوان ياتون بشرح حل وتجده يضع الملف برابط اخر شخصي سواء على قناة يوتيوب او غيره 3. وهنا قمة استخفاف العقول وهو التسويق بطرح رابط قناته فقط وبه شرح لموضوع بسيط ياخذ فيه ساعتين شرح فيديو والمصيبة ان اغلب مافي قناته ان لم تكن كلها اتى بالحل من منتدانا هذا وفي اخر الفيديو يطلب لايكات اخيرا زبدة وجهة النظر عندما يكون هناك علاقة بين طرفين لابد ان يكون هناك منفعة متبادلة وبمستوى مختلف والا ستموت هذه العلاقة يوما من الايام فعلى سبيل المثال في المنتدى هنا انا استفيد من طرح الاستفسار حتى لو هو سهل واعرف اجابته ولكنه يعطيني فكره جديده او معلومه على الاقل فكرة الحاجة فقد تكون جديده ولها قيمتها من زوايا اخرى .. المهم نحن نتبادل الفائده في المشاركات ولو باحتمال 1% من احد الاسئلة السهلة جدا وهنا لو سالت اخي محمد سلامة ماهي فائدتي انا لو شاركة وقيمت البرنامج ؟ من المستفيد وبالنسبة؟ ستجده هنا هو استفاد 100% وانا صفر ؟ معناته هذه المشاركات من هذا النوع المنفعة غير متبادله وبمعنى انها ستموت العلاقة واعتقد هذا مايقصد الاخ @SEMO.Pa3x في كلمة فارغ واعتقد كذلك ان الاخ سيمو عندما قال في دولتك لا يقصد ابدا عنصرية بل كانها محاولة بان الافضل ان تسال في منطقتك لانه فعلا لا استطيع ان اقيم برنامج وانا لست من نفس الدولة الا ان يكون برنامج اصبح دوليا ومنتشرا فهو نصحه وقد يكونون من نفس الدولة لان قصده الطريق الصحيح تقبلو اجمل تحية

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

لجعل إدخال البیانات أكثر سھولة وللتحكم في القیم InputMask يمكنك استخدام الخاصیة التي يمكن أن يدخلھا المستخدمون في عنصر تحكم مربع النص. س 1: ماھي الطريقة التي أجعل المستخدم يدخل 4 أرقام في حقل رقم الھاتف أجبارياً وبدون مسافات أو أي أحرف أخرى ؟ ج: في خاصية قناع الإدخال ضع: 0000 س 2 :وإذا أردت أن أسمح بالمسافات أو ترك بعض الحقل فارغا بشرط أن لايزيد الإدخال عن 4 حروف ؟ ج: في خاصية قناع الإدخال ضع: 9999 س 3 :لقد حاولت بما ذكرته لي في الجواب السابق أن أضع بین الأرقام علامة + وعلامة – ولكن لم استطع فما ھي الطريقة في ذلك ؟ ج: في خاصية قناع الإدخال ضع: #### س 4 :ماسبق ھو في الأرقام ، ولكن كیف أجعل المستخدم يدخل أربعة حروف ولايسمح له بكتابة أقل من ذلك ؟ ج: في خاصية قناع الإدخال ضع: LLLL كبير ولايصح صغيراً. L يجب أن يكتب حرف س 5: ھذا واضح ، فما الطريقة لجعل إدخال الأحرف اختیارياً ؟ ج: في خاصية قناع الإدخال ضع: ???? س 6 :لكن لم تخبرني ھل يمكن في الحالتین السابقتین أن يدخل المستخدم أرقاماً مع الحروف ؟ ج: لا. س 7: إذن ما الطريقة إن احتجت لذلك ، ما أقصده أن يكون الإدخال حروف أو أرقام أو كلاھما ولكن إجباريا وعدد الأحرف أربعة ؟ ج: في خاصية قناع الإدخال ضع: AAAA كبيراً. A يجب أن تكتب حرف س 8: وإن أردت ما سبق اختیارياً ؟ ج: في خاصية قناع الإدخال ضع: aaaa س 9 :لكنه لم يسمح لي بإدخال مسافات في طريقة السؤال السابع ، ما أريده أن يكون الإدخال إجباريا يسمح بالأرقام والحروف والمسافات ؟ ج: في خاصية قناع الإدخال ضع: &&&& س 10 :وإن أردت السابق ولكن اختیارياً ؟ ج: في خاصية قناع الإدخال ضع: CCCC س 11 :عندي حقل نصي أسجل فیه كلمة سر ، وأريد أن تظھر الأحرف على شكل نجمة فما الطريقة ؟ ج: في خاصية قناع الإدخال ضع: Password س 12 :كیف أجعل الحروف المدخلة دائما كبیرة بواسطة قناع الإدخال ؟ ج: في خاصية قناع الإدخال ضع: >ثم بقية القناع ، مثال: '*>LLL*' س 13 :وإذا أردت الحروف صغیرة في كل الحقل ؟ ج: في خاصية قناع الإدخال ضع: >ثم بقية القناع ، مثال: <LLL س 14 : وإذا أردت القناع بعض الأحرف صغیرة وبعضھا كبیرة كیف أفعل ؟ ج: في خاصية قناع الإدخال ضع: >ثم بقية القناع ثم < ثم بقية القناع مثال: >LLL<LLLLL س 15 : كیف استطیع أن أغیر الحرف النائب الافتراضي _ الى حرف أو رمز آخر ؟ ج: في آخر القناع ضع الحرف النائب مكرراً ، مثال: لوضع = كحرف نائب اكتب: *>LL00000*\-0000;=;= س 16 :أريد بعض الأمثلة على قناع الإدخال ؟ ج : قناع الإدخال أمثلة القيم تعريف (000) 000-0000 (206) 555-0248 (999) 999-9999! (206) 555-0248 ( ) 555-0248 (000) AAA-AAAA (206) 555-TELE #999 -20 2000 >L????L?000L0 GREENGR339M3 MAY R 452B7 >L0L 0L0 T2F 8M4 00000-9999 98115- 98115-3007 >L<?????????????? Maria Pierre ISBN 0-&&&&&&&&&-0 ISBN 1-55615-507-7 ISBN 0-13-964262-5 >LL00000-0000 DB51392-0493 sk قناع الإدخال

اعرض الملف الاتصال بالجداول الخلفية لقاعدة بيانات او اكثر من قاعدة والتنقل بينهم السلام عليكم ورحمة الله تعالى وبركاته اهديكم واضع بين اياديكم هذا المثال والذى من خلاله يتم الارتباط بقاعدة / او عدة قواعد خلفية دفعة واحدة والتنقل فيما بينهم برمجيا آلية العمل -عمل اختبار للاتصال بالقاعدة الخلفية وإذا فشل الاختبار ينتقل للمرحلة التالية - البحث اليا عن المجلد الاصلى بجوار قاعدة البيانات الامامية فى حالة وجوده يرتبط اليا بجميع القواعد بداخله بمجرد الموافقة على ذلك من خلال الرسالة أو يمكنك تغير المسار للبحث بنفسك واحضار قاعدة الخلفية او القواعد إن زاد عددهم عن واحدة بمجرد اختيار المجلد الموجودة به -المرجلة التالية هى تأكيد واختيار القاعدة /أو القواعد والتى تخص هذه القاعدة الأمامية -المرحلة التالية بعد تأكيد اختيار القواعد فى هذه المرحلة والأخيرة نختار القاعدة التى نتصل بها وان كانت تحتوى على كلمة مرور نكتبها فى المكان المخصص لذلك وهنا على سبيل المثال قاعدة الخلفية ArchivingTables2018 تم عمل باسورد لها للتجربة وهو 2018 اما القاعدة ArchivingTables2019 لم يتم عمل باسورد لها وكما تشاهدون فى الصورة تم التنقل بكل سهولة وبكل اريحية بين القاعدتين هناك ميزة اخرى ولكن لم استطع تجربتها وهى الاتصال كذلك بجهاز كمبيوتر اخر والذى يحتوى على قاعدة الخلفية فى حالة الشبكة المحلية وذلك بكتابة اسم مستخدم الجهاز كلمة المرور المخصصة للاتصال بالجهاز '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' _ +--officena------oOo-------oOo--------+ _ ' ' /o)| |(o\ ' ' / / | منتــديات اوفسيـنا | \ \ ' ' ( (_ | _ _ | _) ) ' ' ((\ \)+-/o)----oOo----oOo---------------(o\-+(/ /)) ' ' (\\\ \_/ / \ \_/ ///) ' ' \ / \ / ' ' \____/ \____/ ' ' ===============================oOo----oOo============ ' ' ----{ By Mohammed Essam )---- ' ' ----{ www.officena.net/ib/profile/129737-ابا-جودى )---- ' ' ======================oOo-------oOo================== ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' فى انتظار تجربتكم وابداء آرائكم القيمة وأبداعاتكم بأفكاركم الرائعة ☺ Automatically relink Access tables.rar Automatically relink Access tables.zip صاحب الملف ابا جودى تمت الاضافه 31 مار, 2019 الاقسام قسم الأكسيس  

الهدف مجهول بالنسبة لي ولكن انظري المرفق ..... test (1).accdb

السلام عليكم تم التعديل على المعادلات حسب الشروط التي ذكرتها (مع إعطاء التقدير "أقل من المتوقع" لكل طالب لا يحقق على الأقل أحد هذه الشروط)... بن علية حاجي التقديرات حسب الجدول.xlsx

للمعلومات فقط الدالة VLOKKUP تعمل في اي جدول دائماً من اليمين الى اليسار للغة العربية والعكس للغة الاجنبية و يجب ان يكون عمود البحث هو العامود الاول من الجدول لذلك لا يمكن استعمالها في ملفك وضعت لك معادلة بديلة في الملف المرفق Book_salim.xlsx

أهلا @محمد احمد لطفى استخدم الدالة التالية Function AddMonth(XDate As Date) Select Case XDate Case (#8/1/2016#) To (#10/19/2018#) And (Day(XDate) > 23) XDate = DateAdd("m", 1, XDate) Case (#10/20/2018#) To (#12/30/2024#) And (Day(XDate) > 19) XDate = DateAdd("m", 1, XDate) End Select AddMonth = Format(XDate, "yyyy/mm") End Function إليك التعديل: datex.accdb

انظر الصور مع تعديل العبارة select الموجودة في الصورة باسم الحقل الموجود في جدولك والذي يحوي حقل نعم/لا تابع الصور .....