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

وعليكم السلام جرب الكود التالي Private Sub UserForm_Initialize() Dim fso As Object, oFolder As Object, sPath As String, i As Long sPath = "D:\" Set fso = CreateObject("Scripting.FileSystemObject") UserForm1.ListBox1.Clear If fso.FolderExists(sPath) Then Set oFolder = fso.GetFolder(sPath) For Each oFolder In oFolder.SubFolders If Left(oFolder.Name, 1) <> "$" Then i = i + 1 UserForm1.ListBox1.AddItem oFolder.Name End If Next oFolder End If Set fso = Nothing End Sub

السلام عليكم ارجو من الخبراء اعطاء تقيم للموضوع يوجد شرح فيديو بسيط https://youtu.be/pQY_Pxch9kM pos WORK.xlsm

شرح اضافي

نعم يمكنك اختصار الكود كالتالي لانه في الاصل المعادلة موجودة فقط يتم تحويلها الى قيم ويتم تحديثها عند كل تعديل في البيانات ' وضع المعادلة WSData.Range("P10:P" & DerLig).Formula = "=""(""& O10&"" / ""&N10&"")""" With WSData.Range("P10:P" & DerLig) End With

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

في اصدار 21 يكون التنسيق الافتراضي لقاعدة بيانات فارغة واعتقد الامر نفسه من اصدار 2016 2000 2002-2003 2007-2016 والسبب ان 2007 الى 2013 متشابهه اما 2016 الاصدار 16.0.7812 فاحدث يدعم رقم كبير فاذا استخدمنا هذا النوع فان الملف لايمكن فتحه بالاصدارات الاقدم والاصدار 2021 يحتوي على حقل من نوع توسيع تاريخ وقت وايضا غير متوافق مع الاصدارات ما قبل 21 ولكن اذا لم نستخدم هذين التنسيقين فان الناتج يمكن فتحه من 2007 الى 2021 والله اعلم

لا مشكلة فعلا هي قاعدة البيانات 2007 هل رأى احد منكم اصدارا احدث ؟ هذه الصورة من اكسس 2010

شكرا لك أخي @Foksh 🙂 الكود يجلب أرقام ال IP adress للأجهزة بدون اسم الجهاز .. للعلم

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

الافضل ان تثبت التواريخ في الجدول جرب هذه المحاولة stlist.accdb

جرب هذه الفكرة البسيطة stlist.accdb

لم أقم بتجربة هذا الكود ، انشئ وحدة نمطية جديده واكتب الكود فيها :- Function GetConnectedDevices() Dim objShell As Object Dim objExec As Object Dim strCommand As String Dim strOutput As String Set objShell = CreateObject("WScript.Shell") strCommand = "arp -a" ' يمكك استبداله بأمر آخر حسب نوع الشبكة الخاصة بك Set objExec = objShell.Exec(strCommand) strOutput = objExec.StdOut.ReadAll GetConnectedDevices = strOutput End Function جرب استدعاء الكود بمربع نص مثلا عن طريق GetConnectedDevices()

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

يمكنك استثناء اوراق العمل الاخرى داخل الكود بالطريقة التالية Sub CreateSheets() Dim mydata As Worksheet: Set mydata = ThisWorkbook.Sheets("Sheet1") Dim MyRng As Range, RngCopy As Range, Sh As Collection Dim cell As Range, DerLig As Long, ws As Worksheet Dim wsDest As Variant, s As String, SheetName As String Set MyRng = mydata.Range("C6:C" & mydata.Cells(mydata.Rows.Count, "C").End(xlUp).Row) Set Sh = New Collection With Application .ScreenUpdating = False .DisplayAlerts = False End With '*********' قم باظافةاسماء اوراق العمل الغير مرغوب حدفها من المصنف هنا************** SheetName = "Sheet1,Sheet2" '*********************************************************************************** Application.ScreenUpdating = False For Each ws In Worksheets If InStr(1, SheetName, ws.Name) = 0 Then Réf = Application.Match(ws.Name, arr, 0) If IsError(Réf) Then ws.Delete End If End If Next ws On Error Resume Next For Each cell In MyRng.Cells Sh.Add cell.Value, CStr(cell.Value) Next cell On Error GoTo 0 For Each wsDest In Sh s = wsDest Sheets.Add(After:=Sheets(Sheets.Count)).Name = wsDest ActiveSheet.DisplayRightToLeft = True With mydata DerLig = .Cells(.Rows.Count, "C").End(xlUp).Row .Range("A5").AutoFilter field:=3, Criteria1:=wsDest Set RngCopy = .Range("A5:C" & DerLig) RngCopy.Copy Sheets(s).Range("A5") .Select .[A5].AutoFilter End With Next wsDest For Each wscopy In Worksheets If InStr(1, SheetName, wscopy.Name) = 0 Then Réf = Application.Match(wscopy.Name, arr, 0) If IsError(Réf) Then For i = 1 To 3 wscopy.Cells.EntireRow.AutoFit wscopy.Columns(i).ColumnWidth = mydata.Columns(i).ColumnWidth wscopy.Rows("5:5").RowHeight = mydata.Rows("5:5").RowHeight wscopy.Columns("B:B").ColumnWidth = 70 wscopy.Activate With ActiveWindow .SplitRow = 5 .SplitColumn = 0 .FreezePanes = True End With Next End If End If Next wscopy mydata.Activate With Application .ScreenUpdating = True .DisplayAlerts = True End With End Sub اسلاميات 3.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته الاكواد ربما لملف آخر وانت تحاول ضبطها على ملفك ربما يمكننا مساعدتك عند الإجابة على الإستفسارات التالية: بالنسبة للترحيل الملف عليه ارتباط من ملف آخر لبيانات آمين المستودع والمستلم ورئيس القسم. يمكنك تحديد عناوين الخلايا لحين كتابة الكود ثم وضع المعادلات الخاصة بك . B32 D32 G32............ ....... إضافة انك لابد أن توضح هل يتم تكرار نفس البيانات على طول الفاتورة او نسخها في اول صف فقط وكذلك التاريخ هل عمود التسلسل في شيت تقرير الصرف يتم نسخه من الفاتورة أم إضافة تسلسل جديد بالنسبة للاستعلام ماهو شرط البحث هل رقم الصنف مثلا......

تفضل المرفق بعد التعديل اذهب لسجل جديد 1- اذا تكرر الرقم يعطيك رسالة بتكرار الرقم ولم يحفظة . 2- اذا تركت الحقل خالي يعطيك رسالة .................. DD229-1.accdb

مشاركتاً مع استاذي @ابوخليل تفضل أخي محاولتي . DD229.accdb

نعم يمكن ضع الرسالة في حدث قبل التحديث ولكن سؤالك عائم حدد المطلوب بالضبط .. فارغ او تكرار او خطأ معين وارفق مثال بسيط اذا لم تتمكن

اخي الكريم احب اساعدك بطريقة اكاديمية البرمجة تتم تنفيذا لتصور عملية او فكرة محددة فانت هنا تريد ان تمنح الزبون قطعة مجانية مقابل شراء قطعتين ، واحيانا تمنح قطعة مقابل قطعة ، واحيانا قطعة مقابل 3 او 4 او 5 .... الخ ومن اجل تكون العملية مرنة عند البيع وعند الحسابات يلزم وضع آلية وتحكم لهذا الإجراء اسهل واقرب آلية هي : في جدول الاصناف : عمل حقل تضع فيه نسبة محددة امام الصنف المستهدف ، يتم تحديثه او حذفه حسب الحال عمل حقل آخر للحد الأدنى لعدد القطع المشتراه ما زاد عن ذلك يكون السعر تبعا للنسبة .. في مثالك اذا اشترى ثلاث سيدفع قيمة اثنتين واذا اشترى 6 سيدفع قيمة اربع اذا اشترى 5 او 7 فالدفع سيكون حسب النسبة وبهذه الطريقة تكون الأمور دقيقة وواضحة امام مدقق الحسابات

تفضل استاذ @sm44ms الشرح بفورم1 + أكواد الألوان . اذا كان هذا طلبك لا تنسى الضغط على أفضل اجابة . DD227-2.accdb

TEST _Formula.xlsx

الإخوة الكرام .. السلام عليكم تحية طيبة وبعد فهذا ملف عن كيفية عمل فهارس متعددة في الوورد أرجو أن ينال على إعجابكم شرح_الفهارس_في_الوورد.doc

طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة السلام عليكم اساتذة المنتدي وخبراؤه الكبار الاخوة الافاضل اعلم ان هذه الموضوعات قد قتلت بحثا وطلبا واجابة من الاعضاء وهناك امثلة كثيرة للاساتذة الافاضل الكبار والذي لايصل علمنا او ما لدينا كله الي ذرة واحدة من علمهم ولكني اردت ان اجعل المواضيع الاساسية في عمل اي برنامج في متناول الجميع بطريقة بسيطة وسهله اكثر ما يكون من خلال هذه السلسلة ( اعانني الله علي اكمالها كما ينبغي ) وقصدت ان يكون الموضوع بعنوان واضح ليستفيد منه الجميع عند البحث وسأقدم الشرح بطريقة الفيديو والاكسيل والورد احياناً (((( الدرس الاول )))) شاشة ( فورم ) لادخال بيانات والقيام بتسجيل وترحيل هذه البيانات الي صفحة الاكسيل و الاستعلام من خلالها عن طريق نفس الفورم والتعديل ايضا في البيانات في حالة ما اردنا التعديل في بيان قد سبق ادخاله وطبعاً والاكيد كله من علمكم اساتذتي الكرام الاجلاء وفي الدرس القادم سنتعرف علي بعض الاكواد المعاونة لشاشة الادخال او بمعني ادق اكواد نحتاجها مع شاشة الادخال مثل (تنسيق التكست بوكس ، الترقيم التلقائي في تكست معين ، تنسيق التاريخ في التكست بوكس .... ) واي استفسار .... في الخدمة دائما ... واي شئ غير واضح في الشرح علي استعداد تام لشرحه مرة اخري ومرات اخري واليكم ايضا في المرفقات : 1- ملف اكسيل به الاكواد والشرح هذه المرة داخل الكود ( تم شرح الكود سطر سطر بطريقة وافية وبسيطة جدا داخل الكود نفسه ) 2- عدد ( 3 ) ملف فيديو يشرح طريقة التصميم واضافة الاكواد وكذلك مشاهدة النتيجة جزاكم الله خيرا اساتذتنا اكسيل ..طريقة عمل شاشة ادخال 1.rar فيديو 1 .. طريقة عمل شاشة ادخال 1.rar الملف الفيديو الثاني والثالث في المشاركة التالية حيث لم يمكنني اضافتهم هنا

السلام عليكم و رحمة الله و بركاته الاخوة الاحباب بالمنتدى أقدم اليكم قاعدة بيانات للموارد البشرية HR الاصدار الثاني كلمة المرور : 111 و أسأل الله العلى العظيم أن ينفعكم بهذا العمل و الله الموفق والمستعان و السلام عليكم ورحمة الله و بركاته HR 3 with listbox.rar HR for Windows 8 FADILA.rar

هذه طريقة جديدة للترقيم عن طريق التنسيق الشرطي جربها فهي لاتسبب مشاكل علي الأطلاق بالأضافة إلي طرق أساتذتي السابقة تسلسل تقائي.rar