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

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

بسم الله الرحمن الرحيم كما تعودنا واستكمالا لشروحات الفورم التفاعلي باضافات بعض الحيل والافكار للوصول لشكل يسهل للمستخدم التعامل مع اليوزفورم النهاردة هانتعلم الذاي نعمل قائمة منسدلة لجميع تبويات الفورم من خلال بعض الاعدات في شيت منفصل بعيدا عن تعقيدات الاكواد وتكرارها باستخدام Class Modules كود واحد ومختصر وقائمة واحدة تتغير حسب التبويب كنت وعد احد الاخوة في موضوع الدرس الأول للفورم التفاعلي الاخ اسامة فوزي واحتياجه لفورم متعدد المهام والوظائف ليطور عمله ففضلت ان تكون الاجابة عامة حتى يستفيد منها الجميع وادعوا الله ان اكون عند حسن ظنه وظنكم في. أطروحتنا النهاردة بسيطة وشيقة اشبه بمغامرة انك تعبر عن قدرتك وتعاملك في التصميم والكود كانك رسام يرسم لوحة وبربط بين تفاصيلها لتعبر عن رؤية بصرية محددة في مخيلة من قام بالرسم وحياكة التفاصيل حياكة متناسقة لتصل الي المتلقي بسهولة ويستطيع ان يتعامل معها ويمكنك تغيير المسميات للقوائم المنسدلة او الرئيسية من خلال شيت الاعدادات بكل سهولة وتضيف كما تشاء من تبويات بكل سهولة اسيبكم مع الملف واي شيء يحتاج لشرح او توضيح لا تتردوا في طلبه والله ولي التوفيق Create Dynamic Drop-Down Menu In Excel Userform الملف بالمرفقات مفتوح المصدر Create Dynamic Drop-Down Menu In Excel Userform Officana.xlsm

انت عملت لحالك افضل اجابة 😂 يعني انت حليت الموضوع ...بالخير عليك يازلمة ..

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

اتفضل ser2.rar

بشركم الله بما يسركم .. وكف عنكم مايضركم .. وثبت يقينكم .. ورزقكم حلالا يكفيكم .. وأبعد عنكم كل شئ يؤذيكم .. وغفر لكم ولوالديكم ولكل المسلمين والمسلمات يوم العرض .. اللهم آمين 🤲

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

Maybe Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range If Not Application.Intersect(Target, Me.Range("B4:B100")) Is Nothing Then For Each cell In Application.Intersect(Target, Me.Range("B4:B100")) If cell.Value = "Yes" And cell.Offset(0, -1) = Empty Then cell.Offset(0, -1).Value = Date ElseIf cell.Value = "No" And cell.Offset(0, -1) <> Empty Then cell.Offset(0, -1).ClearContents End If Next cell End If End Sub

طيب ... بارك الله فيك ... جرب كده واعلمنا بالنتيجة Kan_st-photo.rar أخي @kams3008 سؤالك خارج عن موضوع السؤال الاساسي ..... لذلك افرد سؤالك في موضوع مستقل ... بارك الله فيك

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

تفضل كود بطريقة بدائية ربما تفيد إن شاء الله ولعل الأساتذة لديهم أفضل من ذلك Budget 2023.xlsb

الكود هو المعرف الخاص بالزبون ، يمكن يكون رقم الهوية مثلا لذا المفترض يكون نوعه نصي وليس رقمي فائدة : نستخدم الحقول الرقمية فقط في الحقول التي نريد استخدامها للمبالغ او يدخل فيها العمليات الحسابية جمع وطرح ... الخ وفي مثالك كود الزبون هو للتعريف فقط فالافضل يكون نصي .. مثل حقل الهاتف ( لا نجري عليها عمليات حسابية)

الحقيقة لم افهم المطلوب ! كما تعلم يكون التركيز على نموذج واحد ، ولا ادري كيف يمكن تشغيل نموذجين مع بعض

وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي Sub SansDoublons() Set f = Sheets("المخزن") Set M = Sheets("البيانات") Application.ScreenUpdating = False Set réf = CreateObject("Scripting.Dictionary") A = Range(f.[C3], f.[C65000].End(xlUp)).Value For Each c In A réf(c) = "" Next c Set dest = M.Range("C3") dest.Resize(réf.Count, 1) = Application.Transpose(réf.keys) ' ترتيب ابجدي dest.Resize(réf.Count, 1).Sort Key1:=dest, Order1:=xlAscending Set réf = Nothing End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'في حالة الرغبة بوضع الكود في حدث الشيت Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Range("C:C")) Is Nothing Then Set f = Sheets("المخزن") Set M = Sheets("البيانات") Set réf = CreateObject("Scripting.Dictionary") A = Range(f.[C3], f.[C65000].End(xlUp)).Value For Each c In A réf(c) = "" Next c Set dest = M.Range("C3") dest.Resize(réf.Count, 1) = Application.Transpose(réf.keys) dest.Resize(réf.Count, 1).Sort Key1:=dest, Order1:=xlAscending Set réf = Nothing End If End Sub V1_تصفية بيانات المخزن .xlsm

بالـتأكيد...تستطيع من خلال الاستعلام ..بجملة السكوال التالية SELECT Count(data.jop_hala) AS CountOfcase FROM data HAVING ((((data.jop_hala))="يعمل") And ((intNu)=True)); أو من خلال مربع نص في النموذج ..وتضع الجملة التالية في مربع عنصر التحكم =DCount("[fullname]","[data]","[jop_hala] Like 'يعمل' And [intNu] =true ")

اخى عمر بل يمكن استخدامهم داخل الاستعلام ايضا ولكن غير مستحب وذلك لما تسببه من بطىء شديد فى حاله كثره السجلات واليكم رابط لاخى جعفر جزاه الله عنا كل خير وربنا يشفيه ويرجعلنا بالسلامه ان شاء الله ( يشير بعدم استخدامهم بالاستعلام ) واليك المثال لاستخدامها فى الاستعلام وبالتاكيد فهو ليس بحاجه لها كما ذكرت انت واخى قاسم ويكفى استعلام تجميع بالتوفيق vacations_1.accdb

المطلوب HostIP اسم المضيف بمعلومية الآي بي واذا شبكة داخلية مطلوب اسم الجهاز بمعلومية IP Address يمكن يوجد اكواد مختصرة تقوم بالمهمة انظروا الى مصنف اكسل يحقق الغرض لقلة خبرتي في اكسل لو احد الاخوة يعدل الكود الى اكسس 42_Lookup_Hostname.xlsm

إن كنت تقصد كود معرفة ال IP للجهاز حسب فهمي المتواضع فهذه الدالة تقوم بذلك : 🙂 Function GetIPAddress() As String Dim objWMI As Object Dim colAdapters As Object Dim objAdapter As Object Dim strIPAddress As String Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2") Set colAdapters = objWMI.ExecQuery("Select * from Win32_NetworkAdapterConfiguration") For Each objAdapter In colAdapters If Not IsNull(objAdapter.IPAddress) Then strIPAddress = objAdapter.IPAddress(0) Exit For End If Next objAdapter GetIPAddress = strIPAddress End Function

جزيل الشكر والامتنان للاخ/ lionheart كما هو مطلوب.

حسب الجدول لديك فأنك لاتحتاج الى Dsum انما الى استعلام تجميع فقط كما موضح بالصورة

لا اعتقد انه يمكن (والله اعلم) لان دوال ال D كلها دوال استعلامية فى حد ذاتها لكن يمكن عمل استعلام جمع مثل SELECT vacations.EmpIDL, Sum(vacations.vacations) AS Sumمنvacations FROM vacations GROUP BY vacations.EmpIDL;

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

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

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

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

Not so clear for me Here's the modified code that enables you to add new data without clearing the existing data Sub Get_Data_From_Closed_Workbooks() Dim a, wb As Workbook, ws As Worksheet, sFile As String, sPath As String, lr As Long, m As Long Application.ScreenUpdating = False sPath = ThisWorkbook.Path & "\" sFile = Dir(sPath & "*.xlsx") m = shSales.Cells(Rows.Count, "E").End(xlUp).Row + 1 ' With shSales.Range("B1").CurrentRegion.Offset(1) ' .ClearContents: .Borders.Value = 0 ' End With Do While sFile <> "" Set wb = Workbooks.Open(sPath & sFile, ReadOnly:=True) Set ws = wb.Sheets(2) With ws lr = .Cells(Rows.Count, "E").End(xlUp).Row a = .Range("B2:H" & lr).Value .Parent.Close False End With shSales.Range("B" & m).Resize(UBound(a, 1), UBound(a, 2)).Value = a m = m + UBound(a, 1) sFile = Dir() Loop With shSales.Range("B2:H" & m - 1) .Borders.Value = 1 End With With shSales.Range("D2:D" & m - 1) .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C" .Value = .Value End With Application.ScreenUpdating = True MsgBox "Done", 64 End Sub The point of duplicates is not clear at all As for creating a shortcut icon, you can do that following the quick access bar

تفضل

اخي تفضل نسخة من المركز.xls

دالة InStrRev خيار آخر لفصل اسم الملف من اسم المسار الكامل.

Change this line to suit you If Target.Column = 2 Or Target.Column = 4 Or Target.Column = 6 Then

أخي @TQTHAMI مبارك عليك حصولك على الحل الصحيح .. 🙂 وتنبيه بسيط جدا : خيار أفضل إجابة يوضع على مشاركة الشخص التي حققت المطلوب ، تعبيرا عن شكرك له .. وتسهيلا للوصول إليها لاحقا 🙂🌹

عند كلمة function اكتب قبلها PtrSafe function وعند كلمة long اكتب بعدها longPtr وراح يعمل معك إن شاء الله