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

جرب هذا الملف ..لقد تم وضع زر لمسح بيانات الورقة الثانية اذا اردت بدء العملية من جديد check column (1).xlsm

وعليكم السلام أولاً لعمل منع تكرار بعمود رقم السيارة واسم المالك مجتمعين .. فيمكنك استخدام هذه المعادلة من خلال خاصية Data Validation =COUNTIFS($A$2:$A$2000,$A2,$B$2:$B$2000,$B2)=1 ولعمل حماية لصفحة البيانات بدون أكواد فعليك بالدخول على قائمة Developer ثم Visual Basic أو بالضغط على Alt F11 للدخول على محرر الأكواد ثم بعد ذلك اتبع الصورة المرفوعة للتعلم ..واذا أردت فك الحماية وإظهار الصفحة اتبع نفس الخطوات ولكن عليك بلإختيار الأول وهو -1-Sheetvisible ..كما تم حذف كل المكرر من البيانات وضبط الملف وشكراً متابعة الملاك.xlsx

وعليكم السلام ورحمة الله وبركاته أشكركم أستاذنا الفاضل الأستاذ الدكتور@محمد طاهر عرفه على ردكم الجميل على موضوعي هذا كما أشكر أستاذنا الفاضل @Ali Mohamed Ali. راجياً لكم التوفيق والنجاح الدائم كان هذا مجرد اقتراح لتسهيل وتصويب العمل والتدقيق في المواضيع الغاية منه السعي قدماً في تطوير المنتدى الكريم، وفي المحصلة حضراتكم أدرى بما يصلح شؤون هذا الموقع الكريم وكما قيل: أهل مكة أدرى بشعابها. تقبلوا تحياتي العطرة ..والسلام عليكم ورحمة الله وبركاته.

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

السلام عليكم أنا أُفضل أن يتم التعامل مع مشاركات الأعضاء الجدد باللين و النصح ، واذا لم يستجيبوا يتم معاقبتهم بوضع مشاركاتهم قيد المراجعة كاجراء إداري موحه ضد من يصر على عدم اتابع قواعد المشاركة عن عمد فقط.

@ابواميمةجرب هذا واعلمني data.xlsm

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

اسف اخي -تفضل 12_mh.xlsm

السلام عليكم آسف علي التأخير عملت علي آخر مرفق تفضلت به حضرتك ويبدو انه لا يحتوي علي بيانات كافية ارجو ان تقوم بالتجارب علي بيانات اكثر وتوافني بالنتائج 1388424466_T3Q-Copy.accdb

بعد ادن الاستاد عبدالفتاح في بي اكسيل ..اليك حل اخر يغنيك عن اضافة ازرار اخرى Option Explicit Private Sub CheckBox1_Click() Call ForAllCheckBoxes(CheckBox1) End Sub Private Sub CheckBox2_Click() Call ForAllCheckBoxes(CheckBox2) End Sub Private Sub CheckBox3_Click() Call ForAllCheckBoxes(CheckBox3) End Sub Private Sub CheckBox4_Click() Call ForAllCheckBoxes(CheckBox4) End Sub Private Sub CheckBox5_Click() Call ForAllCheckBoxes(CheckBox5) End Sub Private Sub ForAllCheckBoxes(ChkBox As Control) Dim fndHead As Range, col As Long If ChkBox.Value = True Then With Sheets("Sheet2") Set fndHead = .Range("1:1").Find(What:=ChkBox.Caption, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False) If Not fndHead Is Nothing Then MsgBox "The " & ChkBox.Caption & " column already exists" & vbLf & _ "You need to uncheck to remove existing first" Exit Sub End If End With With Sheets("Sheet1") Set fndHead = .Range("1:1").Find(What:=ChkBox.Caption, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False) If Not fndHead Is Nothing Then .Columns(fndHead.Column).Copy Else MsgBox ChkBox.Caption & "Not found" Exit Sub End If End With With Sheets("Sheet2") If .Cells(1) = "" Then col = 1 Else col = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1 End If .Columns(col).PasteSpecial End With Application.CutCopyMode = False Else With Sheets("Sheet2") Set fndHead = .Range("1:1").Find(What:=ChkBox.Caption, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByColumns, _ SearchDirection:=xlNext, MatchCase:=False) If Not fndHead Is Nothing Then .Columns(fndHead.Column).Delete End If End With End If End Sub check column.xlsm

تفضل 1542070317_-1.xlsx

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

يالضبط دكتور محمد طاهر وهذا بالفعل الذى يتم

جزاك الله خيرا استاذ @Moosak من فضلك ممكن كود للحذف

اتمنى ان يكون المطلوب انظر المرفق https://wayprograms.blogspot.com/search/label/اكسس TEST.accdb

موجود طبعاً, فكان عليك استخدام خاصية البحث بالمنتدى قبل رفع مشاركتك !!! Create Dependent Drop-down Lists with Conditional Data Validation

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

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

لا يمكن ذلك لأن ذلك سيتم بأكواد vba وهى بدورها لا تعمل على التليفون وشكراً

وجزاكم مثله استاذنا الغالى ابو يوسف جعل الله اعمال استاذنا الفاضل في ميزان حسناته يوم القيامه

جزاكم الله خيرا 🏵️ أخي الحبيب @hassona229 . أعمال الأخ @ياسر خليل أبو البراء رائعة وهو شعلة ذكاء متقدة . أرجو للأخ السائل الفائدة من هذا الفيديو والسلام عليكم ورحمة الله وبركاته

وعليكم السلام ورحمة الله وبركاته هل تتذكر اي شيئ عن الرقم السري ارقام. ولا حروف ولا رموز ولا الكل معا هل تتذكر اي شيى ام لا. فيديو يوضح لك طريقه لمحاوله فتح الملف https://youtu.be/S-_O9H0Mm0c

بدل هذا السطر: If .Cells(ss, 16) <> "ناجح" Then بهذا السطر: If Not .Cells(ss, 16) Like "ناجح*" Then إذا أحببت إضافة مواد الغياب على مواد الإكمال في خانة النتيجة، أخبرني.

جرب المرفق: كود توزيع القرار_16.xlsm

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

:: السلام عليكم ورحمة الله وبركاته :: 🙂 يطيب لي أن أهديكم هذه الهدية البسيطة 🎁 :: مرسال الواتسأب :: وهو برنامج بسيط جدا لإرسال الرسائل عن طريق الواتسأب .. مع إمكانية إرسال المرفقات كذلك ( صور أو مستندات ) 🙂 وله واجهتين رئيسيتين : 1 - الرسائل الفردية 2 - الرسائل الموجهة لعدة أشخاص :: وهذه صور لواجهات البرنامج :: طبعا من الضروري تنصيب برنامج الواتسأب للكمبيوتر وتشغيله قبل تشغيل البرنامج 🙂 وبملاحظاتكم ودعواتكم دوما نرتقي 🙂 :: وأخيرا :: التحميل :: ☺️👌🏼 مرسال الواتسأب.accdb

تفضل كان عليك استخدام خاصية البحث بالمنتدى قبل رفع مشاركتك , فطلبك تكرر كثيراً ..واليك الحل مشكلة في اللغة العربية

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

السلام عليكم ورحمة الله تعالى وبركاته بالنسبة للكود يمكنك جعله بهده الطريقة اخي الكريم وسبب تاخيري عن الرد على طلبك هو انني كنت انتظر جوابك بخصوص كود المنتج لاكن للاسف جوابك غير مفهوم (كود المنتج يكتب آليا ) تتضمن عدة امور Private Sub CommandButton10_Click() If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("b:b"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If With ActiveSheet If .FilterMode Then .ShowAllData lr = .Cells(Rows.Count, 1).End(3).Row + 1 Cells(lr, 1).Resize(, 4) = Array(lr - 1, txt_product, txt_price_sale, txt_price_pru) End With Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = "" MsgBox "Done", vbtnformation End Sub اما الزيادة التي سبق ان وعدتك بها في المشاركة السابقة هي عبارة عن ملفك يتضمن جميع الاظافات التي من الممكن ان تحتاجها . ترحيل _ تعديل _ حدف _ بحث بكود المنتج Private Sub CommandButton9_Click() '''''''''ترحيل البيانات''''''''' ''الشرط الاول'' If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If ''الشرط الثاني'' If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If ''الشرط الثالث'' If IsNumeric(Me.txt_price_sale) = False Then MsgBox "الرجاء ادخال سعر البيع", vbCritical Exit Sub End If ''التحقق من وجود اسم المنتج مسبقا '' Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then MsgBox "هذا المنتج مضاف مسبقا", vbCritical Exit Sub End If ''''''''''' النطاق المرحل اليه'''''''''''' Dim lr As Long lr = Sheets("product_master").Range("B" & Rows.Count).End(xlUp).Row With sh .Cells(lr + 1, "b").Value = Me.txt_product.Value .Cells(lr + 1, "c").Value = Me.txt_price_pru.Value .Cells(lr + 1, "d").Value = Me.txt_price_sale.Value End With ''''''''افراغ textbox''''''' Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" ''''''''(A)ترقيم تلقائي لعمود '''''' ''مع امكانية حدف الصفوف '' Worksheets("product_master").Activate Application.EnableEvents = False With Range("a2:a" & Cells.Find("*", , , , xlByRows, xlPrevious).Row) .Formula = "=Row() - 1" .Value = .Value End With Application.EnableEvents = True MsgBox "تم الترحيل بنجاح", vbtnformation '' UserForm_تحديث '' Unload Me frm_product_master.Show End Sub '''''''''' البحث بكود المنتج'''''''''''' Private Sub CommandButton10_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txtSearch.Value = "" Then MsgBox "الرجاء ادخال كودالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then txt_product = Sheets("product_master").Cells(y, 2).Value txt_price_pru = Sheets("product_master").Cells(y, 3).Value txt_price_sale = Sheets("product_master").Cells(y, 4).Value End If Next y End Sub ''''''''''''''''تعديل البيانات'''''''''''''''' Private Sub CommandButton12_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txt_product.Value = "" Then MsgBox "الرجاء ادخال اسم المنتج", vbCritical Exit Sub End If If IsNumeric(Me.txt_price_pru) = False Then MsgBox "الرجاءادخال سعر شراءالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then Sheets("product_master").Cells(y, 2).Value = txt_product Sheets("product_master").Cells(y, 3).Value = txt_price_pru Sheets("product_master").Cells(y, 4).Value = txt_price_sale End If Next y Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" MsgBox "تم التعديل بنجاح", vbInformation End Sub ''''''''''''''''حدف صف معين'''''''''''''''' Private Sub CommandButton13_Click() Dim x As Long Dim y As Long x = Sheets("product_master").Range("A" & Rows.Count).End(xlUp).Row If Me.txtSearch.Value = "" Then MsgBox "الرجاء ادخال كودالمنتج", vbCritical Exit Sub End If For y = 2 To x If Sheets("product_master").Cells(y, 1).Value = txtSearch.Text Then Rows(y).Delete End If Next y Me.txtSearch.Value = "" Me.txt_product.Value = "" Me.txt_price_pru.Value = "" Me.txt_price_sale.Value = "" MsgBox "تم حدف البيانات بنجاح", vbInformation Call MH Unload Me frm_product_master.Show End Sub ''''''''''''''''UserForm _ تحديث واجهة '''''''''''''''' Sub Refresh_data() Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("product_master") Dim lr As Long lr = Sheets("product_master").Range("a" & Rows.Count).End(xlUp).Row If lr = 1 Then lr = 2 With Me.ListBox .ColumnCount = 4 .ColumnHeads = True .RowSource = "product_master!A2:d" & lr End With End Sub Private Sub CommandButton14_Click() If MsgBox("هل تريد الخروج من البرنامج", vbQuestion + vbYesNo, "Confirmation") = vbYes Then Unload Me End If End Sub Private Sub ListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean) txtSearch.Text = ListBox.Column(0) If txtSearch.Text = Me.ListBox.Column(0) Then Me.txt_product = Me.ListBox.Column(1) Me.txt_price_pru = Me.ListBox.Column(2) Me.txt_price_sale = Me.ListBox.Column(3) End If End Sub المحل_MH.xlsm

السؤال هل هناك رقم او رمز معين لكود المنتج او ترقيم تلقائي 1.2.3 إلى آخره

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

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

مجرد تخمين بناء على كلامك ..احدف هذه الاسطر في نهاية الكود Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = ""

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

ربما كان المطلوب Faris.xlsx