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

🤔

ما شاء الله تبارك الله ممتاز اخي الكريم والتصميم هادئ ومختصر .... استمر ....

Range("AB8") = t t = "" Set fnd = .Find("Û", , , 1) v = fnd.Address If Not fnd Is Nothing Then Do t = IIf(t = "", Cells(2, fnd.Column).Text, t & "+" & Cells(2, fnd.Column).Text) Set fnd = .FindNext(fnd) Loop Until v = fnd.Address End If Range("AB10") = t End With

تفضل <><><><><><> 01.accdb

بعد اذن استاذنا الغالي @ابو جودي اتفضل المرفق اتمنى يكون مطلوبك https://wayprograms.blogspot.com/ محاسب العمال.rar

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

السلام عليكم و رحمة الله و بركاتة يسعدني في هذا الموقع تقديم الزمن الصحيح لجميع الصلوات طوال اليوم وذلك لجميع المدن في الدول العربية ، وهي مفيدة جداً لمن يقطنون في مناطق بعيدة عن المساجد ولا يستطيع معرفة اوقات الاذان لأي فرض طوال اليوم. للعلم بان الاكواد تم عملها بواسطه الاستاذ الكبير @ياسر خليل أبو البراء فجزاه الله خير الجزاء على المجهود و جعله الله في ميزان حسناتهم و المطلوب لاكمال الرنامج اولا : اضافة التاريخ الميلادي Label3 بحيث يتغير كل 50 ثانية ثانيا : اضافة وقت المتبقى للاذان فى Label30 ثالثا : تغيير مواقيت الصلاة من 24 ساعة الى 12 ساعة مواقيت الصلاة.xlsb

أخي الحبيب أحمد عبد الحليم شرفت بمرورك العطر بالفعل الاكواد تم نسخها من شئت اخر وهي كانت سبب المشكله بسبب التنسيق أشكرك أخي الفضل تقبل مني خالص تحياتي وتقديري

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

وعليكم السلام ورحمة الله وبركاته استاذنا الفاضل @Yasser Fathi Albanna المشكلة فى شيت PRODUCTS فى تنسيق الخلايا من A4:A7 عندما قمت بتحديد هذا المدى وكليك يمين واختيار Clear Contents وكتابة الاكواد يدويا المعادلات فى شيت INVOICE تعمل بشكل صحيح ربما سبب المشكلة ان هذه اكواد المنتجات تم نسخها من شيت او ملف اخر ولصقها فى شيت PRODUCTS واخذت نفس تنسيق اضفت الرد فى نفس الوقت مع رد حضرتك تقبل تحياتى

تفضل هذا الملف .على الرغم ان كان عليك من البداية رفع ملف بالمشاركة فلا تعنى أى مشاركة شيء بدون ملف يدعمها Colored.xlsb

قمت بتجربة المثال الأخير يلي فيه تغيير لون الخط لكن عند تعديل الفورم فيه خانة (POp up) الى نعم ترجع زر النعم وال لا الى (Yes) و (No) ما الحل ياغالي وشكرا

استاذنا الفاضل احمد عبدالحليم بعد اذن حضرتك محتاج فقط تعديل مكان خلية اظهار توايخ الغياب نظر لنقل مكان التسجيل مثلا من الخلية R8 و الخلية R10 الى الخلية AB8 و الخلية AB10 الحمد للحمد لله باقى الخلايا غيرتها و الف شكر لحضرتك و اهتمامك

في هذه الحالة لا أعتقد أن الترقيم التلقائي سيفيدك ، وستضطر إلى استخدام الترقيم باستخدام الدالة dlookup مع الدالة dmax شرط ان يكون حقل الترقيم في الجدول number وليس autonumber. هذا رأيي والله اعلم ☺️

Sub Supprimer_tous_les_objets() For Each ws In ActiveWorkbook.Worksheets With ws On Error Resume Next ws.DrawingObjects.Delete On Error GoTo 0 End With Next End Sub

يجدر القيام بحلقة تكرارية في هذه الحالة Sub delete_tools() Dim ws As Worksheet For Each ws In Worksheets ws.DrawingObjects.Delete Next ws End Sub

بالاستفادة من فكرة الأستاذ موسى، دالة لتعطيك مخرج نعم/لا للاسم الذي يحتوي على عدد الأجزاء المطلوبة، ولا داعي لطرح واحد من عدد الأجزاء: Option Explicit Function NamePartsCounter(ByVal sName As String, ByVal Parts As Byte) As Boolean Parts = Parts - 1 sName = Trim(sName) Do While InStr(1, sName, " ") > 0 sName = Replace(sName, " ", " ") Loop NamePartsCounter = Parts = (Len(sName) - Len(Replace(sName, " ", ""))) 'If NamePartsCounter Then Debug.Print sName End Function 'إجراء لفحص الدالة Sub test() Debug.Print NamePartsCounter("عبدالله أحمد علي", 3) End Sub وأنصح في تخزين الأسماء باستخدام الـ "أندرسكور" بدلا من المسافة ، وعند العرض يتم معالجة الأسماء بتديل الأندرسكور بالمسافة باستخدام دالة Replace

السلام عليكم و رحمة الله و بركاتة ياسر خليل أبو البراء احمد عبدالحليم أسأل الله العلي القدير إنه يجعل ماتقدمونه من خدمة ومساعدة للناس في فعل الخير يجعله في ميزان حسناتكم وان لايحرمكم الأجر

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

إذا كنت ستعتمد على عد المسافات بين الأسماء .. فيمكنك استخدام الدالة التالية لعد المسافات الفاصلة بين الأسماء بغض النظر عن الأسماء ذوات الضروف الخاصة كالأسماء المركبة وغيرها .. 1- أضف حقل محسوب في الاستعلام وهذه قيمته ( تستبدل Text باسم حقل الأسم ) : Len(Text) - Len(Replace(Text; " "; "")) 2- في المعيار أسفل هذا الحقل تكتب الرقم 3 وذلك ليحضر لك الأسماء الرباعية .. أو تكتب الرقم 2 ليحضر لك الأسماء الثلاثية

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

الق نظرة على هذه القاعدة رابط الموضوع الصلى full control arabic Message Box 32x,64x .mdb

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

لم اجد تفاعل أو اى رد يدل على نجاح فاعلية التطبيق والتجربة وهذه القواعد للتجربة تم مراعاة عند كتابة الأكواد العمل على كل من النواتان 32x , 64x استاذى الجليل الاستاذ @Moosak اردت فقط الاطمئنان على المكتبة العامرة Moh3sam.zip

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

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

اتفضل اداة تساعدك مستقبلا من تصميم الاستاذ القدير @Moosak اتفضل شوف الدرس ده ان اردت الشرح والايضاح

وعليكم السلام ورحمة الله وبركاته حبا وتقديرا للاستاذ الفاضل @ياسر خليل أبو البراء تفضل مواقيت الصلاة.xlsb

@samycalls2020 @عبدللرحيم أنا ممتن جداً لكم على تواصلكم باسمي ونيابة عن كافة الشعب المغربي ⁦‪أشكركم‬⁩ فرداً فرداً ⁦‪على‬⁩ ⁦‪تعازيكم‬⁩ ودعمكم لنا في هذا المصاب الجلل، و أقول للجميع شكر الله سعيكم وعظم أجركم وجزاكم الله عنا خير الجزاء ولا اراكم الله مكروها بأنفسكم ولا عزيز عليكم وغفر الله لأمواتنا وامواتكم ومن قال امين سائلا المولى عز وجل أن يتغمدهم بواسع الرحمة والمغفرة، وأن يلهم ذويهم الصبر والسلوان، وأن يشفي الجرحى والمصابين .

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

تأكد من مسار الحفظ عندك .... انظر ....

مشاركة مع اخي @محمد احمد لطفى تفضل ..... Output_Path = "C:\Users\ACER\Desktop" & "\" & Format(Date, "dd-mm-yyyy") & ".xlsx" DoCmd.OutputTo acOutputQuery, "استعلام1", "ExcelWorkbook(*.xlsx)", Output_Path, True, "", , acExportQualityPrint

السلام عليكم بها نبدأ أى مشاركة -بما انك لم تقم برفع ملف -فيمكنك استخدام هذا الكود لطلبك: Sub ColorCompanyDuplicates() Dim xRg As Range Dim xTxt As String Dim xCell As Range Dim xChar As String Dim xCellPre As Range Dim xCIndex As Long Dim xCol As Collection Dim i As Long On Error Resume Next If ActiveWindow.RangeSelection.Count > 1 Then xTxt = ActiveWindow.RangeSelection.AddressLocal Else xTxt = ActiveSheet.UsedRange.AddressLocal End If Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8) If xRg Is Nothing Then Exit Sub xCIndex = 2 Set xCol = New Collection For Each xCell In xRg On Error Resume Next If xCell.Value <> "" Then xCol.Add xCell, xCell.Text If Err.Number = 457 Then xCIndex = xCIndex + 1 Set xCellPre = xCol(xCell.Text) If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex ElseIf Err.Number = 9 Then MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel" Exit Sub End If On Error GoTo 0 End If Next End Sub

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

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

لتكبير حجم الفورم بطريقة احترافية توصلت و اخيرا لهذا الكود بدون مشاكل ان كان السيستم 32 او 64 😉 #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal ms as Long) #End If Option Explicit 'http://www.mrexcel.com/archive/VBA/24009.html Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long Private Const GWL_STYLE As Long = (-16) 'Sets a new window style Private Const WS_SYSMENU As Long = &H80000 'Windows style Private Const WS_MINIMIZEBOX As Long = &H20000 Private Const WS_MAXIMIZEBOX As Long = &H10000 Private Const SW_SHOWMAXIMIZED = 3 Private Sub UserForm_Activate() Dim lFormHandle As Long, lStyle As Long '=========================================== '= Originally from Dax = '= Modified with comments by Ivan F Moala = '= 22/07/01 = '=========================================== 'Lets find the UserForm Handle the function below retrieves the handle 'to the top-level window whose class name ("ThunderDFrame" for Excel) 'and window name (me.caption or UserformName caption) match the specified strings. lFormHandle = FindWindow("ThunderDFrame", Me.Caption) 'The GetWindowLong function retrieves information about the specified window. 'The function also retrieves the 32-bit (long) value at the specified offset 'into the extra window memory of a window. lStyle = GetWindowLong(lFormHandle, GWL_STYLE) 'lStyle is the New window style so lets set it up with the following lStyle = lStyle Or WS_SYSMENU 'SystemMenu lStyle = lStyle Or WS_MINIMIZEBOX 'With MinimizeBox lStyle = lStyle Or WS_MAXIMIZEBOX 'and MaximizeBox 'Now lets set up our New window the SetWindowLong function changes 'the attributes of the specified window , given as lFormHandle, 'GWL_STYLE = New windows style, and our Newly defined style = lStyle SetWindowLong lFormHandle, GWL_STYLE, (lStyle) 'Remove >'< if you want to show form Maximised 'ShowWindow lFormHandle, SW_SHOWMAXIMIZED 'Shows Form Maximized 'The DrawMenuBar function redraws the menu bar of the specified window. 'We need this as we have changed the menu bar after Windows has created it. 'All we need is the Handle. DrawMenuBar lFormHandle End Sub

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

أخي الحلبي .. يمكنك تطويع الكود في المرفق اللذي أرسله الأخ أبو الحسن .. هكذا .. تكتب الرسالة في الكود هكذا : ShowBalloonTooltip "اكتمل", "تم الحفظ بنجاح", btNone ولإظهار الأيكونة لديك عدة خيارات تكتبها في المتغير الثالث ، وهي كالتالي : btNone btInformation btWarning btCritical المرفق :رسالة الحفظ.accdb ولنعرف شكل الرسالة الذي تقصدة بالضبط ،، اعطنا رابط أو صورة للفيديو الذي شاهدته 🙂

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

تفضل اخى تصميم الاخوة بالمنتدى تقبل احترامى عرض رسالة على شريط المهام.accdb

البرنامج اتفضل بع تعديل المطلوب منع تكرار الحجز3.rar

بارك الله فيك وجزاك الله كل خير وهذا هو الملف مرفوع هنا لإكتمال الفائدة Rest vba.xlsm

محمد بيه ازييك للمعرفة والتعلم بارك الله فيك

اليكم شرح الجذأ الثالث والاخير من شرح الجمعية التعاونية

أختى الكريمة حاولت التطبيق على ملفك شيت سجل الرصد لكن يفلح الامر لأنه كما قلت لك كمية البيانات فى الشيت ضخمة 200 صف x اكتر من 237 عمود لذلك قمت بعمل نموذج مصغر اليك طريقة العمل : تحديد نطاق البيانات المراد التعامل معه وتسميته باسم Mydata عدد 2 Class Module باسم Class3 و Class4 كما هما بدون تعديل وبنفس الاسم كود استدعاء الفورم بنعمل فيه تعديلات حسب الحاجة كاسم النطاق و عدد خلايا الشبكة التى تظهر فى صفحة MultiPage فى كود الفورم تعليقات بسيطة على السطور المهمة والتى يمكن تعديلها حسب الرغبة والحاجة عند تشغيل الفورم سوف يظهر النطاق Mydata فى MultiPage داخل الشبكة يمكن عمل سكرول لاستعراض البيانات كما يمكن وضع المؤشر فى اى خلية بالشبكة و تعديلها عند الضغط okay سوف تتغير الخلية فى الشيت كما يمكن وضع المؤشر فى التكست بوكس و تعديل العنوان ( بتغيير رقم الصف أو العمود ) ثم الضغط على get لمعرفة قيمتها أو set للتعديل آى استفسار تحت أمرك مع خالص تحياتى show data from-spreadsheet in MultiPage for updatting.rar

وجت المشكلة فين اتفضل الملف المعدل مع امكان اضافة عدد لا محدود من الشيتات تضاف الى ComBox التعديل.rar ايه الاخبار ؟ طمنى

اتفضل البرنامج لو اعجبك اضغط على اعجاب مناوبات الاطباء.rar

الاخ الحبيب بكار طلبك جاهز من يوم الخميس ولكن للاسف المنتدى لم استطع الدخل فيه يوم الخميس ولا ادرى ما اسبب عموما جرب المرفق هل هو ما تريد ادخل الاسم والشهر ثم كتابة مبلغ القسط واضغط انتر ستجد الكود تم ترحيله لو كانت البيانات صحيحه تقبل تحياتى 2015 - Copy.zip

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

أحسنت أخى ابراهيم فكرة جميلة بارك الله فيك