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

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

اسف اخي الكريم نسيت الفانك الصق هذا الفانك في النموذج ..... 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

تقضل جرب Dim MWordDocCopyOf As String Dim NWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(NWordDocCopyOf).Save LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink MWordDocCopyOf Else DoCmd.CancelEvent

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

بارك الله فيك وزادك الله من فضله

تفضل هذه بنواة 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

وده تعديل اضافى ليظهر كما بالصوره للتقرير Q_bait_mon بالتوفيق TEST-22.accdb

ماشاء الله يا @ابو البشر احسنت بارك الله فيك ................... وعالم متخفي

واياك .... جزاك الله خيرا على هذه الدعوات ولك بمثله ..

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

تفضل ...... Dim MWordDocCopyOf As String Dim NWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" If IsFileLocked(LWordDocCopyOf) = True Then MsgBox "يرجى غلق ملف الوورد!" Application.FollowHyperlink LWordDocCopyOf Exit Sub Else FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf NWordDocCopyOf = Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(NWordDocCopyOf).Save End If LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink MWordDocCopyOf Else DoCmd.CancelEvent End If

طيب جرب تجاهل الحل السابق بالكامل وجرب تضيف السطر ده فقط فى دايرة Do Loop على الملف الاصلى دون اي اكود أخرى If Application.Visible = True Then Exit Sub Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do If Application.Visible = True Then Exit Sub Me.Label3.Caption = Time DoEvents Loop End Sub

السلام عليكم المشكله هى Do-Loop فى كود الفورم mainform Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do Me.Label3.Caption = Time DoEvents Loop End Sub ودي بتخللى الفورم شغال الخلفيه طيب ايه الحل 1- ها نعرف المتغير فى اول الفورم خالص وليكن Dim StopClock as Boolean 2- ها نتأكد انه False فى بدايه تشغيل ال form من من حدث Private Sub UserForm_Initialize() StopClock = False End Sub 3- هانضيف شرط فى دائرة ال Do انها ما تعملش حاجه لو StopClock= true Private Sub UserForm_Activate() Me.BackColor = RGB(40, 116, 166) Me.Frame1.BackColor = RGB(40, 116, 166) Me.Label1.Caption = Date Me.Label2.Caption = Format(Date, "ddd") Do If StopClock = True Then Exit Sub Me.Label3.Caption = Time DoEvents Loop End Sub هانتأكد ان قيمة المتغير True قبل ما نعمل unload للفورم Private Sub CommandButton6_Click() Application.Visible = True StopClock = True Unload Me End Sub لما تدوس على الزرار بعد كده هتلاقى الشيتات مفتوحه عادي والايديت عادي جرب الملف المرفق dwork.xlsm

همة مشكورة بارك الله فيك وزادك الله من فضله ..طبعاً رائع هدية مقبولة وموفق دائماَ

اتفضل تم الاستعانه بداله من تصميم الاستاذ احمد عبد المنعم جزاه الله خيرا سوف اضع لك رابطها ويمكن عملها بطرق اخرى رابط شرح الداله على اليوتيوب بالتوفيق TEST-22.accdb

استبدل الكود بهذا ..... Dim MWordDocCopyOf As String Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" FileCopy LWordDocOriginal, LWordDocCopyOf MWordDocCopyOf = LWordDocCopyOf Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open MWordDocCopyOf LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter Nz(b1.Value, "") LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter Nz(b2.Value, "") LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter Nz(b3.Value, "") LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter Nz(b4.Value, "") LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter Nz(b5.Value, "") LWordDoc.Application.Documents(Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx").Save LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Now(), "dd_mm_yyyy_hh_mm_AM/PM") & ".docx" Else DoCmd.CancelEvent End If كل هذا ممكن .... بس خلينا نخلص من اخونا @حامل المسك وابشر استاذ @عمر ضاحى

اللهم صلى وسلم وبارك عليك سيدى يا رسول الله ... أكرمك الله استاذ حسين وزادك الله من فضله

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

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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته اليوم جئتكم بفكرة جديدة وإبداعية لتحديث نسخة الواجهات 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

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

وفيك بارك ... سعدت بمرورك على ردي ... جزاك الله خيرا .. منكم نتعلم

انا شخصيا اجل واحترم مايقدمه الاستاذ احمد عبد المنعم جزاه الله خير جزاء المحسنين

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

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

لقد سبقوني وجزاهم الله خيرا

ممكن تذكرنا سبب ادخالك يوم 15 ضمن المدة..وهل كل الاشهر تعتبر 30 ؟ طبعا ممكن استخدام الطرح مباشرة النتيجة = ([نهاية التاريخ]-[بداية التاريخ])+1 فرق التاريخ.accdb

وعليكم السلام 🙂 هل الهدف معرفة الفرق بين التاريخين ؟ >> في هذه الحالة ليس منطقيا أن نحسب الشهور كلها ل 30 يوم !! وإذا كان الهدف أنك تريد معرفة ما هو التاريخ الذي يصادفه لو أضفنا 30 يوم إلى تاريخ البداية مثلا .. فهذا ممكن عن طريق الدالة DateAdd ..

ستظهر في الtools عبارة Missing Selenium قم بالضغط عليها

استاذ نسور الجو ليه عاوز البيانات تاخدها من ورقة 2 مينفعش لسبب واحد فقط ورقة 1 هذه حضرتك بتكتب فيها الحركه بالتاريخ لكل صنف ان كانت اضافة او صرف بمعني حركة يومية وهي نفس الورقة اللى هدخل فيها البيانات بعد كدة اما عن الورقة الثانية : تعتبر تقرير لاجمالي الاصناف بتاريخ معين واذا قمت بحذف التاريخ مكتوب فيها الفترة من يجيك حركة الاصناف كاملة بدون تواريخ والشيت الثالث اللى قمت بعمله هذا ياخد من الورقة الاولى لانها اساسية والارقام الموجودة بتاخد استنادا على اللى قمت بكتابته من الورقة ا الزبدة في الكلام كله ان الورقة الاولى هذه اساسيه بتكتب فيها الحركة اما الثانية والثالثة تعتبر تقارير فقط

تفضل اخي الكريم ♥ ورقة (1).xls الورقة الاولى فقط اللي تدخل فيها البيانات والباقي بتلاقيه موجود مثل التقارير

الأستاذ / Ali Mohamed Ali هذا هو المطلوب بالتمام والكمال جزاكم الله خيرا

احدف بياناتك قي الشيت الثاني ابتداء من BI1 Sub test() Dim r As Range Sheets("sheet2").UsedRange.Clear With Sheets("sheet1") Set r = .[t1:t2] With .Range("t3", .Range("t" & Rows.Count).End(xlUp)).Resize(, 8) r(2).Formula = "=countblank(" & .Rows(2).Range("c1").Resize(, 6).Address(0, 0) & ")<6" .AdvancedFilter 2, r, Sheets("sheet2").Cells(61) End With r.Clear End With End Sub

استخدم هذا الكود ..... Dim LWordDocOriginal As String Dim LWordDocCopyOf As String Dim Warning As String LWordDocOriginal = CurrentProject.Path & "\asd.docx" LWordDocCopyOf = CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx" FileCopy LWordDocOriginal, LWordDocCopyOf Dim LWordDoc As Object Set LWordDoc = CreateObject("Word.Application") LWordDoc.Documents.Open CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx" LWordDoc.Visible = True LWordDoc.ActiveDocument.Bookmarks("A1").Select LWordDoc.Selection.InsertAfter b1 LWordDoc.ActiveDocument.Bookmarks("A2").Select LWordDoc.Selection.InsertAfter b2 LWordDoc.ActiveDocument.Bookmarks("A3").Select LWordDoc.Selection.InsertAfter b3 LWordDoc.ActiveDocument.Bookmarks("A4").Select LWordDoc.Selection.InsertAfter b4 LWordDoc.ActiveDocument.Bookmarks("A5").Select LWordDoc.Selection.InsertAfter b5 LWordDoc.Application.Documents(Format(Date, "dd-mm-yyyy") & ".docx").Save LWordDoc.Quit Set LWordDoc = Nothing Warning = MsgBox("تم تصدير البيانات للملف ....... هل تريد فتح الملف المصدر", vbYesNo + vbQuestion, "تحذير") If Warning = vbYes Then Application.FollowHyperlink CurrentProject.Path & "\" & "الملفات" & "\" & Format(Date, "dd-mm-yyyy") & ".docx" Else DoCmd.CancelEvent End If

وعليكم السلام استخدم Not In (500;501;502;503;504;505)

وعليكم السلام ورحمة الله جرب كده ...... OpenClsword (CurrentProject.Path & "\asd.docx") Objwrd.ActiveDocument.Bookmarks("A1").Select Objwrd.Selection.InsertAfter Jhhh Objwrd.ActiveDocument.Bookmarks("A1").Select Objwrd.Selection.InsertAfter Subsader Objwrd.ActiveDocument.Bookmarks("A3").Select Objwrd.Selection.InsertAfter Datesader Objwrd.ActiveDocument.Bookmarks("A4").Select Objwrd.Selection.InsertAfter annexes Objwrd.ActiveDocument.Bookmarks("A3").Select Objwrd.Selection.InsertAfter sndOfficialn Objwrd.SaveAs2 CurrentProject.Path & "\" & Date & ".docx" Objwrd.Close False

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

وعليكم السلام-جرب هذه المعادلة =IF(COUNTIF($B$1:$D$3,A8),A8," هذ الاسم غير موجود") Search+Vlookup1.xlsx

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

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

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

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

السلام عليكم ورحمة الله وبركاته،... كثيراً مانحتاج في برامجنا الى ( اسم مُدخل البيانات ) أي الذي قام بكتابة الفاتورة او تعديل أمر ما او طباعة ...الخ نريد أن نعرف من الشخص الذي قام بهذه العملية خصوصاً اذا كانت قاعدة البيانات قد تم ربطها بشكل شبكة ( سلسلة كومبيوترات متصلة بقاعدة البيانات ) كنا نستعمل الطريقة التقليدية أولا: بإنشاء جدول لتسجيل اسم المستخدم الحالي الذي يستخدم قاعدة البيانات في حال مروره بنموذج تسجيل الدخول ثانيا: نقوم بتخزينه في متغير Veriable من نوع String مثلاً وعند المرور بنموذج تسجيل الدخول يتم اسناد القيمة للمتغير في حال كان اليوزر والباسورد صحيحين Public CurrentUserName As String الكلام في الطريقتين صحيح، لكن في الطريقة الأولى سيبقى محتفظاً في اسم المستخدم حتى في حالة إغلاق الأكسس أجبارياً اما الطريقة الثانية فأن هذا المتغير سيفقد القيمة التي قمنا بتخزينها به عند ظهور أول رسالة خطأ من الأكسس جراء تطبيق أمر ما او أي عملية If قمت بكتابتها، بمجرد ظهور رسالة الخطأ ستختفي القيمة من المتغير CurrentUserName ونُصبح في مهب الريح ، حسناً لذلك سنقوم بإستخدام ( TempVars ) دعنا نسميها المخزن، نقوم بخزن اي قيمة بداخلها وتكون بهيئة ( Global Veriables ) يمكن استدعائها من أي مكان وسيتم تصفيرها بعد أغلاق الأكسس أجبارياً او إختيارياً ولن تمحى القيمة بعد ظهور رسالة خطأ كما أوضحت سابقاً. أضافة قيمة: TempVars.Add "CurrentUserName", "semo" إحضار القيمة: MsgBox TempVars("CurrentUserName") يمكنك إسناد الكثير من القيم لـ TempVars والإستفادة منها. لتفاصيل أكثر يمكنكم قراءة المقال من شركة مايكروسوفت: https://docs.microsoft.com/en-us/office/vba/api/access.tempvars.add أي سؤال أنا موجود، تحياتي لكم .

السلام عليكم مينفعش الكل يشارك وأنا واقف أتفرج - معرفش غير أنزل الملعب وأقوم بدور راس حربة - تفضل المرفق التالي به دالتين : الدالة الأولى تقوم باستخراج الأرقام من ضمن النص ، وفيه تفصيل ليها بالملف المرفق ، والثانية تقوم بجمع الأرقام Digits والله المستعان .. Extract Number - Sum Digits Function.rar

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

عذرا أخوتى وزملائى سبب مداخلتى أن هذه الصيغة البسيطة تحقق طلب السائل وفقا لما فهمت من سؤالة وهى معادلة صفيف ولكنها لاتحقق الطلب إذا أختلف النص {=SUM(VALUE(SUBSTITUTE(A1:A2,"كيلو","")))} وهذه الصيغة أيضا بعيدا عن علامة الصفيف =SUMPRODUCT(--(SUBSTITUTE(A1:A2,"كيلو",""))) أرجو أن يكون توضيحى يحمل معنى كلامى تقبلوا تحياتى

أخي الفاضل انت محظوظ جدا على فكرة، كل عمالقة المنتدي تواجدوا بموضوعك وما شاء الله بدل الحل حلول .. انت اللى مش عاوز تتعب نفسك وعاوز حاجة سهلة بدل المعادلات الطويلة علما ان حلول الأساتذة الكرام تفي بالغرض وزيادة عامة مرفق ملف مجمع به كافة حلول الأساتذة الأفاضل أ.سليم وأ.أبو تراب جزاهم الله كل خير وللتسهيل عليك هناك حل آخر مرفق الا وهو دالة تم تسميتها ( SumNo ) تقوم بإحضار الرقم فقط من الخلية انظر الملف المرفق تحياتي مثال.rar

السلام عليكم انا مع ملك المعادلات فى كلامه ولكن اليك محاولة حل بعد حلول الاساتذه الافاضل =LOOKUP(9999999999;1*(MID(A2;SMALL(FIND({0;1;2;3;4;5;6;7;8;9};A2&"0123456789");1);ROW($A$1:$A$23)))) مثال.rar

السلام عليكم سؤال مهم فعلا و احب ان اضيف علاوة ما اضافة الاخوة الكرام السيد سليم و السيد عبدالله انه يمكن استخلاص الارقام من نص عن طريق الدالة SumProduct انظر المثال المرفق فكرة الكود هو ضرب عناصر مصفوفتين عن طريق الدالة sumproduct و من ثم جمع الناتج مثال: في الخلية A1 العبارة التالية: 250 كرتون حليب المصفوفة الاولى تمثل الارقام المستخلصة من النص و هى {0,5,2} المصفوفة الثانية تمثل المنزلة العشرية لكل رقم {1,10,100} و عند ضرب المصفوفتين و جمع الناتج نحصل على 250 هذا كود المعادلة لخلية A1 ممكن ان تحتوي على نص بطول 30 حرف SUMPRODUCT(MID(0&A1,LARGE(INDEX(ISNUMBER(--MID(A1,ROW($1:$30),1))* ROW($1:$30),0),ROW($1:$30))+1,1)*10^ROW($1:$30)/10) استخلاص الارقام من نص.zip

السلام عليكم جرب الملف التالي sum of mix cell.xlsx