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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته اليوم جئتكم بفكرة جديدة وإبداعية لتحديث نسخة الواجهات FE لدى المستخدمين بدون الاستعانة بملفات وبرامج خارجية 🙂 وذلك بالاستعانة بملفي الواجهات FE وملف قاعدة البيانات ( الجداول ) BE فقط 😊 وقد قمت بشرح الفكرة ومحاولة تبسيطها قدر الإمكان من خلال الشرح الآتي مستعيناً بالله وتوفيقه .. :: أصل المشكلة :: أولاً : من المعلوم أنه يفضل أن يكون البرنامج مقسم إلى ملفين ( الواجهات FE - وقاعدة الجداول BE ) وذلك لكي يعمل عليه أكثر من مستخدم. FE: هي اختصار لـ Front End النهاية الأمامية .. أي ملف الواجهات و BE: هي اختصار لـ Back End النهاية الخلفية .. وهو ملف الجداول ملف الـ BE غالبا ما يكون مخزن في السيرفر بطريقة يمكن لجميع المستخدمين من الوصول إليه حيث أن البيانات جميعها يتم تخزينها فيه. ويتم توزيع ملفات الـ( FE) على أجهزة المستخدمين ، وهي محور حديثنا لهذا اليوم الرائع الجميل .. 😊 مختصر الكلام : أنه كثيرا ما يعاني مصممو البرامج من إعادة توزيع ملفات الواجهات ( FE ) على أجهزة المستخدمين عندما تكون هناك تحديثات جديدة على البرنامج أو معالجة لأخطاء في البرنامج ... الطريقة والفكرة التي سنتحدث عنها اليوم تقوم بحل هذه المعاناة وجعل البرنامج يقوم بتوزيع الـ (FE) نيابة عنك أوتوماتيكيا وبدون أي جهد يطلب من المستخدمين .. 😉 :: شرح الفكرة وآلية العمل :: الفكرة التي سأطرحها قائمة على الاتصال بملف الجداول الـ (BE) والاستعانة به ليقوم بتوزيع ملف التحديث الجديد على أجهزة المستخدمين بعد أن يستبدل القديم بالجديد .. حيث أننا سنحتاج إلى : 1 - جدول في قاعدة الـ (BE) ومتصل بنسخة الـ (FE) كذلك، لتخزين روابط مواقع كل ملف ( FE - BE - New Update ). 2- ماكرو Autoexec وضيفته تشغيل الكود الذي سيفحص وجود تحديثات جديدة من عدمه عند بدء تشغيل البرنامج ، ويوضع في نسخة الـ (FE). 3- سنحتاج لإضافة نموذج في نسخة الجداول الـ (BE) مهمته تشغيل الكود الذي سيحدث نسخة الـ (FE). والكود يعمل عند حدث (عند التشغيل - ON OPEN ). 4- سنحتاج لجدول (محلي) يبقى في نسخة الواجهات الـ (FE) فيه حقل تاريخ عبارة عن سجل واحد يكتب فيه تاريخ الإصدار للنسخة الحالية. وهذا شرح مصور مبسط لآلية العمل : الصورة (1) : محتويات الملفات الأساسية المستخدمة في العمل. الصورة (2) : المرحلة الأولى : فحص وجوود تحديثات جديدة من خلال ملف الواجهات FE الصورة (3) : رسالة تأكيد للبدء في التحديث الصورة (4) : الخطوة الثالثة : إغلاق ال(FE) وفتح ال(BE) الصورة (5) : إستبدال النسخة القديمة بالجديدة وإعادة تشغيل البرنامج 🙂 هذا كل شيء ببساطة 😅🖐️ :: الأكواد المستخدمة :: أولاً : الكود المستخدم في ملف الواجهات الـ (FE) : Public Sub UpdateUsersFE(CurrentVerDate As Date, NewVerDate As Date, _ txtOldFEPath As String, txtNewFEPath As String, _ txtBEPath As String, txtBEUpdateForm As String, _ DoTheUpdaet As Boolean) On Error Resume Next ' ************************************************** Check If the Manager Send The Update Order If DoTheUpdaet = True Then ' Continue The Code Else MsgBox "لا يوجد تحديث جديد" Exit Sub End If ' ************************************************** Check Version Date If CurrentVerDate < NewVerDate Then ' Continue The Code ' MsgBox "سوف يتم التحديث إن شاء الله" ' Exit Sub Else ' MsgBox "لديك آخر إصدار" Exit Sub End If ' *************************************************** Confermation Msg. If MsgBox("لديك تحديث جديد للبرنامج، متابعة؟", vbYesNo, "Apply New Update?") = vbYes Then Else: Exit Sub End If ' ************************************************** Open the BE and the Update Form Dim objAdb As Object Set objAdb = CreateObject("Access.Application") objAdb.OpenCurrentDatabase (txtBEPath) objAdb.DoCmd.OpenForm txtBEUpdateForm objAdb.Visible = False ' ************************************************** Close FE Database DoCmd.Quit Set objAdb = Nothing End Sub Public Function testUpdate() Dim BackEndPath As String, FrontEndPath As String, UpdatePath As String, CurrentVerDate As Date, NewVerDate As Date, StartUpdating As Boolean CurrentVerDate = DFirst("[VersionDate]", "[FE_Tbl_Version]") NewVerDate = DFirst("[LastUpdateDate]", "[BE_Tbl_Updates]") BackEndPath = DFirst("[BackEndPath]", "[BE_Tbl_Updates]") FrontEndPath = DFirst("[FrontEndPath]", "[BE_Tbl_Updates]") UpdatePath = DFirst("[UpdatePath]", "[BE_Tbl_Updates]") StartUpdating = DFirst("[StartUpdating]", "[BE_Tbl_Updates]") Call UpdateUsersFE(CurrentVerDate, NewVerDate, FrontEndPath, UpdatePath, BackEndPath, "BE_Frm_StartUpdating", StartUpdating) End Function ثانياً : الكود المستخدم في ملف الجداول الـ (BE) : #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Private Sub Form_Open(Cancel As Integer) Call UpdateFE End Sub Public Sub UpdateFE() Dim FrontEndPath As String, NewUpdatePath As String FrontEndPath = DFirst("[FrontEndPath]", "[BE_Tbl_Updates]") NewUpdatePath = DFirst("[UpdatePath]", "[BE_Tbl_Updates]") 'On Error Resume Next '********************************************************************(Waite for 3 seconds until FE Closed ) Sleep 3000 '********************************************************************(Copy the New Update to the User PC) Dim fs As Object Set fs = CreateObject("Scripting.FileSystemObject") 'Kill FrontEndPath 'Sleep 1000 fs.CopyFile NewUpdatePath, FrontEndPath, True '********************************************************************(Open the new FE for the user) 'Sleep 1000 Dim objAdb As Object Set objAdb = CreateObject("Access.Application") objAdb.OpenCurrentDatabase (FrontEndPath) objAdb.Visible = True objAdb.DoCmd.RunCommand acCmdAppMaximize '*********************************************************************(Close BE) DoCmd.Quit Set objAdb = Nothing End Sub :: (مهم جدا ) قبل التجربة والتطبيق :: ستجدون في المرفقات ثلاثة ملفات: - ملف الواجهات القديم (FE-MyApplication) - ملف الجداول (BE-MyApplicationDatabase) -وملف الواجهات المحدث (FE-NewUpdateV2.0) أولاً : يجب إعادة ربط ملفي الواجهات (القديم + التحديث ) بملف الجداول (يدوياً ) .. وهي خطوة مهمة للعمل .. ( يمكنك عملها أوتوماتيكيا بالأكواد في برنامجك لاحقاً ، لم أشأ تعقيد الأمور هنا 😅) ثانياً : يجب عليك تحديث روابط أماكن الملفات الثلاثة في جدول (BE_Tbl_Updates) وذلك من خلال النموذج (FE_Frm_UpdateInfo) الموجود في نسخة الواجهات. والآن يمكنك الانطلاق والبدء في تجربة البرنامج 😉👊 قم بتشغيل البرنامج FE-MyApplication وانتظر لترى النتيجة 😊👌 ملاحظة : لإعادة التجربة مرة أخرى بعد التحديث ، قم بتأخير تاريخ النسخة الأمامية من جدول (FE_Tbl_Version) إلى تاريخ سابق للتاريخ المخزن في قاعدة البيانات . *************************************************************** هذا كل شيء ولا تنسوا أن تنوروني بآرائكم ومقترحاتكم ولا تنسوني من صالح دعواتكم 😊 :: التحميل :: FrontEnd Updator V1.0.rar

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

السلام عليكم ورحمة الله وبركاته هذا ناتج تمرين اليوم على البرمجة VBA 🙂 :: آلة حاسبة :: أهديكموها مفتوحة المصدر 😊🎁 ملاحظة : تم إضافة خاصية الحساب عن طريق مفاتيح الكيبورد 😊 مع حل مشكلة الأرقام العشرية 😁 آراؤكم ودعواتكم 😉 Moosak Calculator V1.1.accdb

طيب انظر الصور والمرفق هل هذا هو المطلوب ........ Info list.accdb

وعليكم السلام-تفضل 1الاحصاء.xlsx

وعليكم السلام-يمكنك استخدام هذه المعادلة لطلبك =INDEX(القائمة!$C:$F,MATCH(C6,القائمة!$B:$B,0),MATCH(D5,القائمة!$C$6:$F$6,0)) المطلوب1.xlsx

السلام عليكم ورحمة الله اليك الملف بعد التعديل بدلا من ذكر المعادلة فقط لادراجها بنفسك لاحتمال صعوبة تعاملك مع المعادلة المستخدمة و متغيراتها أفواج العطلة.xlsx

السؤال مبهم قليلا ولكن وفق فهمي للسؤال لديك تقرير اذا فتح التقرير من نموذج ا يكون اسم التقرير تقرير 1 مثلا ومصدر بياناته الجدول aa واذا فتحناه من نموذج ب يكون اسم التقرير تقرير 2 ومصدره استعلام 1 مثلا اذا كان فهمي صحيح ممكن استخدام البارامتر السادس في امر فتح التقرير حيث ان امر فتح يحتوي على سته معلمات بالترتيب ReportName View FilterName WhereCondition WindowMode OpenArgs والسادس هو مايهمنا والفكر ارسال قيمة محددة مع امر الفتح على سبيل المثال DoCmd.OpenReport "companies", acViewPreview, , , , 1 او هكذا DoCmd.OpenReport "companies", acViewPreview, OpenArgs:=1 وفي امر فتح للتقرير If Me.OpenArgs = 1 Then Me.Report.Caption = "test" Me.Report.RecordSource = "q_1" Else Me.Report.Caption = "kh" Me.Report.RecordSource = "companies" End If

في مصدر بيانات مربع النص ضع هذا =DSum("[Odb_Qty]";"[Odb_PlaningMonthe_ForCost_ProdactionSUM]";"[Odb_Type] Like 'برميل'") وغير لبقية مربعات النص جالون كرتون بالمناسبة هذه الاداة مفيدة جدددددددددددددددددددددددددددا وشكرا لصانعها وبارك فيه

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته ...نسخة محسنة من البرنامج SEWER.rar

اسف اخي الكريم نسيت الفانك الصق هذا الفانك في النموذج ..... Public Function IsFileLocked(PathName As String) As Boolean On Error GoTo ErrHandler Dim i As Integer If Len(Dir$(PathName)) Then i = FreeFile() Open PathName For Random Access Read Write Lock Read Write As #i Lock i Unlock i Close i Else Err.Raise 53 End If ExitProc: On Error GoTo 0 Exit Function ErrHandler: Select Case Err.Number Case 70 IsFileLocked = True Case Else End Select Resume ExitProc Resume End Function

وعليكم السلام-يمكنك استخدام هذه المعادلة =SUMPRODUCT(--(COUNTIFS(C3:G3,C3:G3,C3:G3,"<>"&"ح")>1)) عدد مرات تكرار الاسم في كل صف وكل عمود معدل1.xlsx

تفضل هذه بنواة 64 بت -بعد اذن جميع الأساتذة فالملف ليس به اى مشكلة فإن واجهتكم مشكلة فاعلم انها من عندك انت فلابد كما أخبرنا من تحميل الأداة والمكتبة الناقصة رابط تحميل السيلينيوم https://github.com/florentbr/SeleniumBasic/releases/download/v2.0.9.0/SeleniumBasic-2.0.9.0.exe رابط تحميل الدريفر الخاص بالسلينيوم https://chromedriver.storage.googleapis.com/102.0.5005.27/chromedriver_win32.zip الكروم درايفر لابد ان يكون اصداره مثل اصدار الكروم المصطب على جهازك نظام ادارة شؤون التلاميذ الاصدار 1.00.rar

عليكم السلام ورحمة الله وبركاته الأمر hide يستعمل في إخفاء النموذج فقط وليس إغلاقه كاملا وهذا يعني إمكاية استعمال جميع المتغيرات والكائنات المستعملة في النموذج الأمر unload يستعمل في إعلاف النموذج كاملا فلا يمكن استعمال أي من متغيراته أو كائناته ويمكن استعمال الأمرين من داخل النموذج me.hide unload me أو من خارجه userform1.hide unload userform1 أما end فلا علاقة لها بالنموذج وإغلاقه فهي تستعمل للتعبير عن نهاية بعض الأوامر مثل End [Function | Sub | With | Select | Type | Enum | If ] أما exit فتستعمل للخروج من بعض الأوامر مثل Exit [ Do | For | Function | Select | Sub ] بالتوفيق

الطريقة الاسهل في حدث في الحالي للنموذج ضع الامر التالي Dim intnewrec As Integer intnewrec = Form.NewRecord If intnewrec = 0 Then Me.AllowEdits = False Else Me.AllowEdits = True End If تحياتي

وهنا الدالة الأخيرة ( علشان ما أغار ) 😂 حساب العمر.rar

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

السلام عليكم مشاركه مع اخوانى واساتذتى جزاهم الله عنا كل خير استخدم القناع التالى 00/00/"202"0;0;_ بالتوفيق Database1.accdb

تفضل ..... Sub kan() On Error GoTo w Dim i As Integer Dim sCount As Integer sCount = Me.Recordset.RecordCount DoCmd.GoToRecord , , acFirst For i = 0 To Me.Recordset.RecordCount Me.datem = DateAdd("d", i, Me.kano) DoCmd.GoToRecord , , acNext Next DoCmd.Requery Exit Sub w: MsgBox "تم" End Sub Private Sub تأريخ_تلقائي_Click() Me.kano = Me.datem kan End Sub

السلام عليكم ورحمة الله وبركاته هذا شيت عمل فاتورة مبيعات ومشتريات وسدادت العملاء والموردين الآجل (مفتوح المصدر) https://www.mediafire.com/file/3kthtk8ogoz4d2g/2022-05-31_09-41-29.mp4/file فيديو شرح اتمنى تنال على اعجابكم ان شاء الله ♥ حركة بيع ومشتريات.xlsm ان شاء الله سوف اعمل فيديو شرح له

اخي الكريم لتسهيل عملية التحديث اقترح عليك ان تستعين بــ Google drive بحيث تقوم برفع آخر نسخة من التعديلات الى Google drive و من خلال الكود سيتم تحميل هذه النسخة الى جهاز العميل او المستخدم الآخر و حتى يتم ذلك يجب ان تقوم بإنشاء Module جديد و الصق فيه الكود التالي Option Compare Database Option Explicit #If VBA7 Then Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As LongPtr, ByVal lpfnCB As LongPtr) As LongPtr #Else Private Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownLoadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long #End If Function downloadFile( _ ByVal FileURL As String, _ ByVal FilePath As String) _ As Boolean Const ProcName As String = "downloadFile" On Error GoTo clearError URLDownloadToFile 0, FileURL, FilePath, 0, 0 downloadFile = True ProcExit: Exit Function clearError: Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _ & " " & "Run-time error '" & Err.Number & "':" & vbLf _ & " " & Err.Description Resume ProcExit End Function Sub downloadGoogleDrive(FilePath As String, FileID As String) Const UrlLeft As String = "http://drive.google.com/u/0/uc?id=" Const UrlRight As String = "&export=download" Dim Url As String: Url = UrlLeft & FileID & UrlRight Dim wasDownloaded As Boolean wasDownloaded = downloadFile(Url, FilePath) If wasDownloaded Then MsgBox "Success" Else MsgBox "Fail" End If End Sub Sub NewFileText() On Error Resume Next Dim FileSeveTo As String FileSeveTo = CurrentProject.Path & "\" & Right$(CurrentProject.FullName, _ Len(CurrentProject.FullName) _ - InStrRev(CurrentProject.FullName, "\")) Dim GoogleFileID As String: GoogleFileID = "1DQqZYciRIs_dcBE6JLeoqiB3zjcq2SpL" Call downloadGoogleDrive(FileSeveTo, GoogleFileID) Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim oFile As Object Set oFile = fso.CreateTextFile(CurrentProject.Path & "\UpdateFile.cmd") oFile.WriteLine "@Echo OFF" oFile.WriteLine "SLEEP 3" oFile.WriteLine "copy " & """" & FileSeveTo & """" & " " & """" & CurrentProject.FullName & """" & " /Y" oFile.WriteLine "call " & """" & CurrentProject.FullName & """" oFile.WriteLine "exit" oFile.Close Set fso = Nothing Set oFile = Nothing 'تشغيل ملف النظام Dim RetVal RetVal = Shell(CurrentProject.Path & "\UpdateFile.cmd", 1) Application.CloseCurrentDatabase End Sub و للاستدعاء لتحميل الملف و استبدال النسخة الحالية للمستخدم استخدم الكود التالي في ازرار التحديث او في اي اجراء تستخدمه للتحديث (( لا تنسى وضع مفتاح الملف الذي حصلت عليه من قوقل )) '=========================================================================== Dim GoogleFileID As String: GoogleFileID = "مفتاح الملف من قوقل درايف" '=========================================================================== Dim FileSeveTo As String FileSeveTo = CurrentProject.Path & "\" & Right$(CurrentProject.FullName, _ Len(CurrentProject.FullName) _ - InStrRev(CurrentProject.FullName, "\")) Call downloadGoogleDrive(FileSeveTo, GoogleFileID)

وعليكم السلام-يمكنك استخدام هذه المعادلة ..وذلك فى حالة ان وقت الإنصراف أقل من وقت الحضور ,ولكن لابد ان يكون فى نفس اليوم ,,وبعد ذلك لابد من تصحيح وتعديل وقت الإنصراق عند إدخاله بمعنى اذا انصرف الموظف الساعة مثلاً 5 وربع مساءاً فلابد من كتابتها وادخالها هكذا 17:15 وشكراً =IF($D2<$C2,($D2+"12:00")-$C2,$D2-$C2) back1.xlsx

وعليكم السلام-تفضل أعتقد ان هذا سيكون أفضل مما طلبت قائمة منسدلة.xlsx

ترى كلنا نحب الصعايدة والنعم فيهم .... اسمح لي استخدم مثالك بطريقة اخرى للفائدة واثراء الموضوع باستخدم هذا الكود .... Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim strSQL1 As String, strSQL2 As String Set db = CurrentDb db.QueryDefs.Delete "qr1" If com1 = "التقرير الاول" Then strSQL1 = "SELECT tblA.ID, tblA.fld FROM tblA;" Set qdf = db.CreateQueryDef("qr1", strSQL1) ElseIf com1 = "التقرير الثاني" Then strSQL2 = "SELECT tblB.ID, tblB.fld FROM tblB;" Set qdf = db.CreateQueryDef("qr1", strSQL2) End If DoCmd.OpenReport "rptFlayReport", acViewPreview وهذا المثال ..... Chang Record Sources Report.mdb

وعليكم السلام ورحمة الله وبركاته ... اعمل مربع نص وسمه مثلا Text7 ثم في حدث عند عداد الوقت للنموذج ضع هذا الكود ... I = I + 1 Me.Text7 = I & "%" If I = 100 Then Me.TimerInterval = 0 ثم اصنع زر وضع في حدثه .... Me.TimerInterval = 100 جرب واعلمنا بالنتيجة ؟؟؟؟

مع التحية والتقدير للاستاذ محمد البرناوي على الحل الرائع ومن باب تعدد الحلول ولكوني من المدرسة القديمة ومن انصار استخدام مربعات النص لاختصار الاكواد فاني سوف اضع طريقة ليست منافسة للكود الرائع لاستاذنا الفاضل ولكن حل على طريقة الطيبين في البداية استخدمنا مربع نص غير منضم اسميته tx3 وقيمته تساوي Me.tx3 = tx3 & "'" & Curr_Grp.Column(0) & "'," ثم في زر الامر لفتح التقرير وضعنا الامر Dim k, w As String k = tx3 w = "st_mstr.Curr_Grp IN (" & Left(k, Len(k) - 1) & ")" DoCmd.OpenReport "r_1", acViewPreview, , w والنتيجة في الصورة تحياتي

تفضل استاذ Moosak شوف بنفسك عمل هذه الأداة

بارك الله فيك استاذ مجدى وزادك الله من فضله

وعليكم السلام-تفضل يمكنك استخدام هذه المعادلة =IF($A2="أربيل",0,IF(AND($C2>=DATE(2022,6,1),$A2="حلة"),10000,5000)) تعديل على معادلة العمولة1.xlsx

بارك الله فيك بهذه الكلمات العطرة وجزاك الله خير الثواب -يمكنك بهذا التعديل ... وطبعاً نعم لابد من زيادة رقم 2 عند الإنتقال لعمود أخر وبالتوفيق ان شاء الله =IF(VLOOKUP($B3,ورقة1!$B$3:$G$9,2,0)="ح","ح",INDEX(ورقة1!$I$3:$I$9,MATCH(ورقة1!C3,ورقة1!J$3:J$9,0))) واذا كنت لا تريد تغيير الرقم كلما سحبت المعادلة لعمود جديد فيمكنك استخدام هذه المعادلة مباشرة دون تعديل رقم العمود =IF(VLOOKUP($B3,ورقة1!$B$3:$G$9,MATCH(C$2,ورقة1!$B$2:$G$2,0),FALSE)="ح","ح",INDEX(ورقة1!$I$3:$I$9,MATCH(ورقة1!C3,ورقة1!J$3:J$9,0))) المساعدة في تحويل الأرقام إلى أسماء 3 .xlsx

https://drive.google.com/file/d/1SGcBrfP4xkaciCbS5Pc74Epvl8-5kDuC/view?usp=drivesdk طبعا لان حجم الملف كبير اضفت لكم رابط تحميل من درايف في التعليق

وعليكم السلام-تفضل على الرغم انك لم تقم برفع الملف .. قيمكنك اضافة هذا السطر بحدث Open Sheets("الرئيسية").Select

احسنت بارك الله فيك ووسع الله فى رزقك

وعليكم السلام-عليك بوضع أى وسيلة اتصال (كرقم تليفون واميل شخصى) بك لسهولة الوصول اليك , ومن لديه الوقت ويريد ذلك سيتصل بك

مشاركة مع حبيبنا المهندس قاسم ..... Not Between 500 And 505

فقط المشكلة كانت لديك فى تنسيق خلية الرقم القومى ةالرقم التأمينى لأنك قمت بعمل تنسيق لتلك الخلايا على أنها تاريخ وليس رقم وشكراً

تفضل <<<<<<< Public Sub colorSet(frm As Form) With frm.Form .Section(acHeader).BackColor = 12874308 .Section(acDetail).BackColor = 16769023 .Section(acFooter).BackColor = 12874308 End With End Sub

السلام عليكم مشاركه مع اخى واستاذى الغالى جزاه الله عنا كل خير Private Sub Form_Current() If Not Me.NewRecord Then Me.AllowEdits = False Else Me.AllowEdits = True End If End Sub

السلام عليكم ورحمة الله وبركاته .. اليوم جايب لكم موقع وظيفته يقرأ أو يشرح لك الكود بلغة إنجليزية مفهومة ، ويمكنك عن طريق المترجم تحويلها إلى اللغة العربية 🙂 وهذا هو الموقع : https://denigma.app الموقع بفضل الله يتعامل مع معظم اللغات البرمجية تقريبا ، ومن ضمنها الفيجوال بيسك VBA .. وهذا شرح مبسط للاستخدام .. بعد فتح الموقع ننزل تحت إلى هذي الخانة، يوضع الكود في الخانة اليسرى ويظهر التفسير في الجهة اليمنى : نجرب نلصق دالة حساب العمر بالسنة والشهر واليوم ونضغط على [Explain it!] : ولترجمته باللغة العربية ، تأخذ النص لمترجم جوجل فيعطيك النتيجة هكذا : 🙂 هذا وسلامتكم ☺️🌹

تاكد جيدا ..الكود مضبوط 100% وقد جربته كثيرا هؤلاء الفرنجة لايخطأون ياطويل العمر😄

بسم الله والصلاة والسلام على رسول الله وعلى آله وصحبه ومن والاه ...إخوتي الكرام السلام عليكم ورحمة الله وبركاته أحببت أن أعرض عليكم بعض إمكانيات الإكسيل الرائعة في تنسيق الأشكال في حال عدم توفّر الفوتوشوب أو البرامج الرسومية الأخرى ليظهر الملف بشكل أنيق ... حبث أنه يتمتع بجماليات في الخط والشكل وتناسق الألوان لكنه بعود على الملف بشيءٍ من البطء وزيادة حجم الملف .. الارتباطات التشعبية تظهر على شكل شفاف كقطرات الندى في صباح ربيعي مزهر..عند وضع المؤشر عليها تدلك على الورقة الهدف. راجياً من الله تعالى أن ينال إعجاب حضراتكم. اسم المستخدم :admin كلمة السر 123 ...بعض أوراق العمل محمية دون كلمة مرور ... والسلام عليكم ورحمة الله وبركاته. مكابس بلوك.rar

حياك الله اخي واستاذي ابو البشر والشكر لله اخي وجودكم انتم واخوننا الكرام هو الدافع لعودتنا بعد طول انقطاع من المؤكد ان الموقع يزخر بالامثلة للترقيم في الاستعلام مع ذلك ساتحدث عن طريقتين ربما تفيد احد من رواد الموقع الطريقة الاولى اذا كان لدينا في الجدول حقل ترقيم ولكن توجد ارقام محذوفة Expr1: DCount("[id]";"tbl_1";"[id]<=" & [id]) الطريقة الثانية اذا كان الجدول لا يحتوي اي حقل ترقيم وانما حقول نصية فقط ⬇️ Expr2: (Select Count(1) FROM [tbl_1] A WHERE A.item <=[tbl_1].[item]) item حقل نصي هنا ☝️من الافضل استخدام تسمية توضيحية حتى لا تظهر لنا رسالة بطلب قيمة معلمة . توجد طرق اخرى عديدة بعضها يعتمد على وحدة نمطية وبعضها بدون ولكن هذه من اسهل الطرق. والى لقاء في موضوع اخر باذن الله تحياتي

شكرا لك أخي مبرمج سابق مبدع بالفطرة ..🙂 أرى أنك أعتمدت على فرضية أن الحقل Id موجود ومرتب تصاعديا بدون وجود نواقص (حقول محذوفة) .. ماذا لو أن حقل ال Id مكتوب هكذا xml0620220856 ؟ كيف نستطيع الحصول على ال 100 سجل الأولى ؟ ثم المائة التالية ؟ ولو كان لدينا 3 قوائم ListBox مثلا في نفس النموذج نريد فيها تقسيم السجلات إلى 3 أقسام متساوية .. كيف نفعل ذلك ؟؟ طبعا الهدف من السؤال هو تحريك الدماغ .. والاستفادة من خبراتكم .. وإثارة روح التحدي .. 👍🏼😁

وعليكم السلام ورحمه الله وبركاته مشاركه مع اخى ومهندسنا العزيز @Eng.Qassim جزاه الله كل خير 💐 اولا يجب الابتعاد عن تسميه الكائنات كالجداول والنماذج وغيرها وكذلك عن تسميه الحقول بالعربى واستخدام خاصيه التسميه التوضيحيه واكتب فيها بالعربى واذا كان الاسم مكون اسمين لا تستخدم مسافات بينهم يفضل الابتداء بحرف كابتل او علامه _ للفصل بينهم بالنسبه لتصميم النموذج ليس من المنطقى وضع حقول للقيم لكل مرحله قمت بالتعديل واستخدام استعلام التحديث وتشغيله فى حدث بعد التحديث لحقل المرحله اكتب القيم المناسبه لكل مرحله ثم قم باختيار المرحله لتحديثها ارجو ان يكون التعديل مناسب لك بالتوفيق اخوانى school.accdb

تفضل طبعاً بعد اذن استاذنا الكريم lionheart .. فالأمر سهل جداً ولكن لابد من الضغط على الإعجاب 💙 من طرفكم لما قدمه لكم استاذنا الكبير lionheart الاباء1.xlsm

In standard module, put the following UDF Function VLookUps(myCode As Range, myList As Range, delim As String, Optional Uniq As Boolean = False) As String Dim e VLookUps = Join(Filter(myList.Parent.Evaluate("TRANSPOSE(IF(" & myList.Columns(7).Address & "=" & myCode.Address(, , , True) & ", " & myList.Columns(2).Address & "))"), False, 0), delim) If Uniq Then With CreateObject("Scripting.Dictionary") .CompareMode = 1 For Each e In Split(VLookUps, delim) .Item(Trim(Split(e)(1))) = Empty Next e VLookUps = Join(.Keys, delim) End With End If End Function In cell F2, you can use the UDF as following =VLookUps(Tabla2[@[إسم ولي الأمر]],Tabla1[#All]," - ",TRUE)

بعد إذن جميع الأصدقاء المشاركين في هذا الموضوع الرائع هذا جهدي المتواضع لتحميل الملفات من جوجل درايف بنفس الاسم والامتداد فقط تحتاج رابط الملف كاملا وأن يكون الملف عاما (مشاركا مع الجميع) الكود يعالج مشكلة أسماء الملفات العربية صالح للنواتين 32بت وكذلك 64بت يعمل في كل التطبيقات التي تستعمل vba يوضع هذا الكود في موديول جديد Sub DownloadFromGD(GDriveURL As String) Dim myURL As String Dim FileID As String Dim xmlhttp As Object Dim name0 As Variant Dim oStream As Object FileID = Split(Split(GDriveURL, "/d/")(1), "/")(0) myURL = "http://drive.google.com/u/0/uc?id=" & FileID & "&export=download" Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") xmlhttp.Open "GET", myURL, False xmlhttp.Send name0 = DECODEURL(xmlhttp.getResponseHeader("Content-Disposition")) If name0 = "" Then MsgBox "الملف غير موجود في الموقع" Exit Sub End If name0 = Split(name0, "*=UTF-8''")(1) 'split after *=UTF-8'' to get utf8 names If xmlhttp.Status = 200 Then Set oStream = CreateObject("ADODB.Stream") oStream.Open oStream.Type = 1 oStream.Write xmlhttp.responseBody oStream.SaveToFile CurrentProject.Path & "\" & name0, 2 ' 1 = no overwrite, 2 = overwrite oStream.Close End If Set xmlhttp = Nothing Set Stream = Nothing MsgBox "تم تحميل الملف في نفس مسار البرنامج باسم: " & name0 End Sub Function DECODEURL(varText As Variant) Static objHtmlfile As Object If objHtmlfile Is Nothing Then Set objHtmlfile = CreateObject("htmlfile") objHtmlfile.parentWindow.execScript "function decode(s) {return decodeURIComponent(s)}", "jscript" End If DECODEURL = objHtmlfile.parentWindow.decode(varText) End Function طريقة استخدام الكود مثل السطر المكتوب في الإجراء test أو يمكن وضعه عند الضغط على زر مثلا ويتكون هذا السطر من كتابة اسم الاجراء DpwnloadFromGD ثم رابط الملف المراد تحميله بين علامتي تنصيص ويمكن استخدام قيمة مربع النص بدلا من تثبيت رابط الموقع Sub test() DownloadFromGD "https://drive.google.com/file/d/18jrvTxgR1QTzwm8YaJHIvsdOmqj02L2x/view" End Sub ولا تنسوني من صالح دعائكم بالتوفيق للجميع

قريبا إن شاء الله .. 😊 طريقة إبداعية جديدة وحصرية لتحديث نسخة الواجهات FE لدى المستخدمين بدون برامج أو أدوات خارجية .. أكسس فقط .. 😉👌🏼 :: ترقبوا ::

يمكنك تحويل المعادلة الي كود مثلا لو أردنا تحويل العمود D نستعمل هذا الاجراء مع ربطه بزر مع حفظ الملف بصيفة تدعم الاكواد مثل xlsb Sub mrmas() Range("d2:d101").Formula = "=rand()" Range("d2:d101").Value = Range("d2:d101").Value End Sub بالتوفيق

حسب فهمي للمطلوب تم تنفيذ المعادلة على العمود الأول E وإذا أردت تطبيقها على العمود التالي يمكنك تغيير الخلية $E$1 في المعادلة الموجودة في الصف الثاني بالتوفيق mas tableau.xlsx