سامي الحداد

مثل ما تفضل به الاستاذ @ابو البشر والكود له جزاه الله خيرا . انا فقط حذفت السطر الاول من الاكسل حسب طلبك جرب ووافينا بالنتيجة . testdate4.rar

نعم أخي الكريم تفضل Private Sub TreeView1_Click() Dim strFormName As String Dim formsDictionary As New Scripting.Dictionary formsDictionary.ADD "بيانات الشركة", "frmCompany" formsDictionary.ADD "بيانات مستخدمي النظام", "frmSystemUserData" formsDictionary.ADD "كلمات المرور", "frmPassword" formsDictionary.ADD "بيانات المطورين", "frmDeveloper" strFormName = TreeView1.SelectedItem.Text If formsDictionary.Exists(strFormName) Then DoCmd.OpenForm formsDictionary(strFormName) Else MsgBox "عذرا هذا النموذج غير موجود", vbExclamation, "تنبيه" End If End Sub واليك الملف بعد التعديل . المكتبات المطلوبة انظر الصورة بالتوفيق MediaSoft 2.rar

وعليكم السلام تفضل اخي الكريم هذا هو الكود المستخدم لفتح اي فورم عندك Private Sub TreeView1_Click() Dim strFormName As String strFormName = TreeView1.SelectedItem.Text DoCmd.OpenForm strFormName End Sub واليك الملف بعد التعديل لقد اضفت لك كل النماذج . هل هو المطلوب؟ MediaSoft 1.rar

المعذرة اخي الكريم نسيت ان اضيف هذا وهو اسم الزر المراد اخفاءه في الكود. Private Sub Form_Open(Cancel As Integer) Call UserPermission(Me, GetUserLoginID()) If TempVars!IsFormOpened = 1 Then Exit Sub Else Call DisableButton(Me, GetUserLoginID, Me.cmdSetPermission, Me. اسم الزر المراد اخفاءه) End If End Sub

وعليكم السلام أخي الكريم بالنسبة ل All Forms فهي للادمن فقط. اما بالنسبة لزر Disable Button فهو لاخفاء زر معين في نموذج أو من القائمة الرئيسية مثلا : في النموذج لديك مستخدم يستطيع ان يضيف ولكن لا يستطيع ان يحذف وهذا النموذج فيه اضافة وحذف هنا يأتي زر الاخفاء بحيث هذا المستخدم لا يستطيع ان يحذف, فقط يستطيع الاضافة. لهذا اضفت هذه الخاصية لتعطيل زر معين. أدخل باسم المستخدم B على ما اعتقد سترى ان زر صفحة الادمن غير مفعلة. وهناك بعض الازرار مفعلة ولكن ليس لدية الصلاحية لفتح النموذج. واليك كيفية عمل ذلك.. استدعاء وظيفة User Permission في كل نموذج ضمن الحدث Form_Open Private Sub Form_Open(Cancel As Integer) Call UserPermission(Me, GetUserLoginID()) End Sub -------------------------------------------------------------------------- إذا كان لديك بعض الأزرار لتعطيلها للمستخدم العادي ، فاستدع الوظيفة "UserPermission" و "DisableButton" ضمن حدث Form_Open Private Sub Form_Open(Cancel As Integer) Call UserPermission(Me, GetUserLoginID()) If TempVars!IsFormOpened = 1 Then Exit Sub Else Call DisableButton(Me, GetUserLoginID, Me.cmdSetPermission) End If End Sub يجب إضافة كل النماذج في جدول tbl_Forms ضروري. اتمنى ان اكون قد وفقت في الشرح وبخدمتكم. تحياتي

أخي الكريم @العبيدي رعد الملف الذي ارفقته لك فيه كل ما طلبت يمكن جنابكم ما فتحتم الملف. سجل الدخول بإسم Sami وكلمة المرور 555 ادخل على صلاحيات المستخدمين واختار المستخدم من القائمة وسترى النماذج والتي بامكانك تغيرها على حسب النماذج التي في برنامجك ومنها تستطيع ان تعطي الصلاحيات لكل نموذج . إذا الموضوع صعب عليك ارفق برنامجك هنا وساعمل لك الصلاحيات المطلوبة لكل مستخدم .. الموضع سهل جدا وما فيه اي تعقيد. غير المستخدم سامي واجعله الادمن وغير اسماء المستخدمين واعطيهم الصلاحيات الطلوبه. بانتظار ردك. تحياتي

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

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

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

الملف المرفق العملاء 2 هو طلبك اما الصورة فهذا الملف لم ارفقة هنا مجرد توضيح فقط لعمل تغير طريقة عمل البحث طبعا هذا مجرد رأي .

السلام عليكم تفضل أخي الكريم تم التعديل على ملفك في المشاركة الاولى . هل هو المطلوب وافنا بالنتيجة. انا لي رأي اخر في عملية البحث انظر للصوره ان احببت سارفق لك الملف . بالتوفيق العملاء 2.accdb

اخي العزيز ابو جودي إنّا لله وإنّا إليه راجعون رحمه الله وآجرك. حسن الله عزاكم فيه، وعظَّم لكم الأجور، وألهمكم التسليم للمقدور، نقول جميعاً كما قال الصابرون إنّا لله وإنّا إليه راجعون.٠

أخي حمدي جرب الكود الان سبب تكرار الارسال هو هذه الاسطر Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || " & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "& app_sent =0" Pause 3 SendKeys "{TAB}" Call SendKeys("~", True) اليك الكود كاملا بعد التعديل Dim IEE As Object Dim SQL As String Dim fso As Object Dim fldrname As String Dim fldrpath As String Dim Mytoname As String Dim stname1 As String Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("email") rs.MoveLast: rs.MoveFirst Dim IE As Object DoCmd.RunCommand acCmdSaveRecord If Nz(DCount("SelectRow", "email", "SelectRow = 'R'"), 0) = 0 Then MsgBox "يجب اختيار المرسل اليه اولا", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If Me.myname.SetFocus If IsNull(Me.msg) Then MsgBox "لايوجد نص للارسال", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If If IsNull([email1].Form![phone_number]) Then MsgBox "لايوجد رقم هاتف", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If DoCmd.OpenForm "email4", acNormal 'Set IE = CreateObject("InternetExplorer.Application") 'IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub & "*" & "& app_sent =0" 'Pause 3 'SendKeys "{TAB}" 'Call SendKeys("~", True) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) If rs.Fields("SelectRow") = "R" Then Mytoname = rs.Fields(0) stname1 = rs.Fields("toname") Dim strMSG As String strMSG = " || *" & Me.myname.Value & "*" & " || *" & Me.msg.Value & "*" & " || *" & Me.attach.Value & "* || " & "المرسل : *" & Me.sub strMSG = ReplaceLineBreaks(strMSG) Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "whatsapp://send?phone=" & rs!phone_number & "&text=""*" & strMSG & "*" & "& app_sent =0" Pause 3 Set IE = Nothing Set IEE = Nothing Dim objClipboard As Object Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClipboard.SetText (MyFile) objClipboard.PutInClipboard Pause 5 SendKeys "+{TAB}" Call SendKeys("{Enter}", True) Pause 2 Call SendKeys("{Enter}", True) Pause 5 Langauge ELanguage.en Pause 5 Call SendKeys("^v", True) Call SendKeys("{Enter}", True) Pause 5 Set objClipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") objClipboard.SetText ReplaceLineBreaks(Me.msg) objClipboard.PutInClipboard Pause 1 Call SendKeys("^v", True) Pause 5 Call SendKeys("{Enter}", True) Pause 1 DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE email SET[SendStuts]='تم الارسال' , SelectRow ='T' WHERE [ID]=" & Mytoname DoCmd.SetWarnings True SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" SendKeys "+{TAB}" End If rs.MoveNext Wend End If rs.Close Set rs = Nothing MsgBox "تم الارسال" End Sub ' =================================(وهذه دالة لجعل الواتسأب يقبل السطور الجديدة في النص المرسل) Function ReplaceLineBreaks(text As String) As String ReplaceLineBreaks = Replace(text, vbCrLf, " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(10), " %0a ") ReplaceLineBreaks = Replace(ReplaceLineBreaks, Chr(13), " %0a ") End Function المعذرة أخي لم أجرب الكود على البرنامج وذلك لانشغالي . جرب الكود هذا وان شاءالله عندما يسمح الوقت ساكون معكم . بالتوفيق

وعليكم السلام ورحمة الله وبركاتة مشاركة مع الاستاذ خليفة جزاه الله خيرا تفضل اخي الكريم لقد عملت لك المطلوب وان شاءالله يكون حسب طلبك هذا ما سمح بة وفتي . المستخدمين كالتالي الاسم: علي كلمة المرور 123 الاسم: رضوان كلمة المرور 123 الاسم: سامي كلمة المرور 555 سامي لديه كل الصلاحيات اما علي فله بعض الصلاحيات وبالنسبة لرضوان ليس لديه اي صلاحية حاول ان تتعرف على كيفية العمل .. أسف جدا لن استطيع الشرح مع الصور الان بالتوفيق ساغيب عن المنتدى لبضعة ايام بسبب السفر والعمل. PasswordLogin_RC4_v5.4.accdb

وعليكم السلام مشاركة مع الاساتذة تفضل التعديل =IIf(Format([التاريخ],"yyyy/mm")<Format(Now(),"yyyy/mm") And [تم الدفع]=0,"قسط متأخر",IIf(Format([التاريخ],"yyyy/mm")>Format(Now(),"yyyy/mm") And [تم الدفع]=0,"لم يحن وقت السداد",IIf(Format([التاريخ],"yyyy/mm")=Format(Now(),"yyyy/mm") And [تم الدفع]=0,"جاهز للسداد"," تم السداد"))) 182.accdb

وعليكم السلام اخي الكريم جرب التعديل ووافنا بالنتيجة تحياتي Database3.accdb

تفضل اخي الكريم بالتوفيق Database2.accdb

وعليكم السلام اخي الكريم بما انك لم ترفق ملفك اليك هذا الكود عسى ان يكون هو طلبك ... Dim strSQL As String Dim i As Integer Dim Msg As String Dim NewID As String If NewData = "" Then Exit Sub NewID = UCase(Trim(Left(NewData, 3))) Msg = "'" & NewData & "' غير موجود حاليًا في قائمة الأنواع." & vbCr & vbCr Msg = Msg & "هل تريد إنشاء سجل نوع جديد?" i = MsgBox(Msg, vbQuestion + vbYesNo, "نوع غير معروف...") If i = vbYes Then strSQL = "Insert Into [Your Table Here] ([Your ComboBox],[FieldName]) values ('" & NewID & "','" & NewData & "')" CurrentDb.Execute strSQL, dbFailOnError Response = acDataErrAdded Else Response = acDataErrContinue End If غير الاسماء حسب مسميات الحقول والقائمة المنسدلة والجدول لديك تحياتي

السلام عليكم لقد عملت برنامج خاص للبحث في جميع حقول الجداول ووضعته في هذه المشاركة جرب ووافيني بالنتيجة ساضع البرنامج هنا مرة ثانية ربما يستفاد منة باقي الاعضاء تحياتي Search All Tables 2020 New.accdb

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

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

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

السلام عليكم مشاركة مع أساتذتي جزاهم الله خيرا صحيح كلامك استاذي الفاضل أبو خليل , بعد ان عطلت كود إخفاء الاوفيس عمل النموذج بصوره صحيحة وبدون ان أغير في باقي الاعدادات. ساحاول ان شاءالله معرفة الخلل اين . وهذه محاولتي بالنسبة لباقي السؤال.. زيادة مني شوي ..😄 اليك الكود. Private Sub Command17_Click() On Error Resume Next Dim strPath As String Dim strFileName As String Dim strReport As String Dim OutPath As String strReport = "T1" strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "T1" & " " & Format(Date, "dd-mm-yyyy") If Dir(strPath, vbDirectory) = "" Then MkDir strPath OutPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "T1" & " " & Format(Date, "dd-mm-yyyy") & " " & ".PDF" MsgBox " تم عملية انشاء المجلد مع تصدير الملف الى سطح المكتب", vbInformation, " تأكيد " strFileName = CurrentProject.Path & "\T1\" & strFileName DoCmd.OpenReport "t1", acViewReport, , "itemid=" & itemid & "" DoCmd.OutputTo acOutputReport, "t1", acFormatPDF, strPath & "\T1" & " " & Format(Date, "dd-mm-yyyy") & " " & ".PDF", True, , , acExportQualityPrint DoCmd.Close acReport, strReport Else If strPath > 0 Then DoCmd.CancelEvent MsgBox " الملف موجود مسبقا بهذا الاسم والتاريخ " & vbCrLf & _ "T1" & " " & Format(Date, "dd-mm-yyyy"), vbInformation + vbMsgBoxRight, "تم إلغاء العملية" Exit Sub End If End If End Sub أخي الدكتور محمد كنت قد سألتني عن ثلانة اشياء في هذه المشاركة https://www.officena.net/ib/topic/117397-طباعة-محتويات-النموذج-على-ان-يكون-اسم-الملف-المطبوع-هو-تاريخ-اليوم-تلقائيا-عند-غلق-النموذج/ هل هذا هو المطلوب في هذه المشاركة ايضا ام لا ؟ واسف على التاخير في الرد بسبب ظروف العمل والسفر حيث عملي يتطلب ان اسافر كثيرا وهذا ما يمعني من التواجد بصفة مستمرة ارجو المعذرة من الجميع. تحياتي للجميع فتح تقرير غير منكمش.accdb

احسنت اخي الكريم @TQTHAMI وجزاك الله خير الجزاء على هذه المشاركة الجميلة.

الف الف مبروك أخي العزيز @Ahmed.IQ تستأهل كل الخير. اسأل الله لكم التوفيق والنجاح دائما. تحياتي