كل الانشطه

وعليكم السلام ورحمة الله وبركاته .. حاولت فهم الموضوع من معطياتك أخي الكريم ولكني لم أوفق .. ان أمكن توضيح أكثر فنكون من الشاكرين

وعليكم السلام ورحمة الله وبركاته Private Sub Worksheet_Change(ByVal Target As Range) Dim rg As Range, cell As Range Set rg = Intersect(Target, Columns("A")) If rg Is Nothing Then Exit Sub Application.EnableEvents = False On Error GoTo CleanUp For Each cell In rg If Not IsEmpty(cell.Value) Then If Not cell.Value Like "???-###-####" Or _ IsNumeric(Left(cell.Value, 3)) Or _ Not IsNumeric(Mid(cell.Value, 5, 3)) Or _ Not IsNumeric(Mid(cell.Value, 9, 4)) Then MsgBox "الرجاء إدخال القيمة بالتنسيق الصحيح: 3 حروف-3 ارقام-4 ارقام", vbExclamation cell.ClearContents End If End If Next cell CleanUp: Application.EnableEvents = True End Sub aaa-123-4345.xlsb

Select column A for example then from Data tab select Data Validation Select Custom and paste the formula This is the formula you can use =AND(ISNUMBER(VALUE(MID(A1,5,3))), ISNUMBER(VALUE(MID(A1,9,4))), ISERROR(VALUE(LEFT(A1,3))), MID(A1,4,1)="-", MID(A1,8,1)="-", LEN(A1)=12)

100% 👌🏻

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

الإخوة الكرام .. السلام عليكم ورحمة الله وبركاته في الملف المرفق استعلام (QF_Subject) فيه حقول بياناتها أرقام، أريد استبدالها بالأسماء التي ترمز إليها * أولا: المطلوب أن تظهر الأسماء في الحقول ( (LVL1name – LVL2name - LVL3name – LVL4name ومصدرها واحد وهو حقل (SName) ولكن باعتبار أرقام الحقول: (LVL1 - LVL2 - LVL3 - LVL4 ) فليظهر الاسم المطلوب لـ (LVL1) يجب اعتبار باقي المستويات = 0 وليظهر اسم (LVL2) يجب اعتبار (LVL3) (LVL4) = 0 وفي الجدول (Q_Subject) النتائج المراد الوصول إليها * ثانيا: أن تظهر الأسماء في (TYPE2name - TYPE1name) ومصدر هذه الأسماء من جدول آخر وهو (DATA_list) وبعد عدة محاولات تمكنت من الوصول للمطلوب لكن بتكرار الجدول في الاستعلام ، فهل هذه هي الطريقة الصحيحة ؟ QF_Subject.accdb

السلام عليكم اخواني واعزائي الكرام اريد تقييد عمود كامل في الإكسل بالتقييد التالي 3 حروف ثم علامة - ثم 3 أرقام ثم علامة - ثم 4 ارقام مثال AAA-000-0000

تفضل استاذ @ابو عبد الله العراقي محاولتي حسب مافهمت . اليك الكود بعد التعديل . MergMic_KH_3.rar

إذا الآن يستحق الموضوع اغلاقه بفضل الله تعالى 😉

استاذ @ابوخليل اكيد عندي اسئلة كثيرة بس والله خجلان منك لان الاسئلة كثيرة سؤال : رقم الفاتورة : InvoiceID هل يتم تعبئته يدوي او المفروض بصورة تلقائية لان لدي صيفة بالتنسيق يكون تلقائي ("NO:"000000) اكيد انا افضل ان يكون اخر موضوع هو الدفع بعد اكمال متطلبات العمل الحالي نحن عندنا الخصم يكون على مجمل الفاتورة وليس صنف معين ومع ذلك نستفيد منكم ان شاء الله

وجدت تغيرات طفيفة في التعديل الاخير مكعوسة وتمت معالجة المشكلة توفي الزوج بعد تاريخ طلاق الزوجة Me.k7.Visible = False Me.Da7.Visible = True Me.Za7.Visible = True Else Me.k7.Visible = True Me.Da7.Visible = False Me.Za7.Visible = False والحمد لله اما بخصوص تنسيق التاريخ تم ايجاد حل عموما شكرا لك استاذي الكريم وربي يحفظك ومايحرمنا من تواجدك معنا ومد يد المساعدة لاخوانك الله يجعلها في ميزان حسناتك ان شاء الله

Try #If VBA7 Then Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr #Else Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long #End If Function CreateElevatedFile(ByVal sFilePath As String, ByVal sFileContent As String) As Boolean On Error GoTo ErrorHandler Dim fso As Object, sScriptPath As String, psScript As String, EscFilePath As String, EscContent As String sScriptPath = Environ("TEMP") & "\create_elevated_file.ps1" EscFilePath = Replace(Replace(sFilePath, "'", "''"), """", "\""") EscContent = Replace(Replace(sFileContent, "'", "''"), """", "\""") psScript = "$t = [System.Diagnostics.ProcessWindowStyle]::Hidden;$p = Start-Process -WindowStyle $t -FilePath 'powershell.exe' -ArgumentList '-Command ""Set-Content -Path \""" & EscFilePath & "\""` -Value \""" & EscContent & "\""""' -Verb RunAs -PassThru;$p.WaitForExit();Exit $p.ExitCode" Set fso = CreateObject("Scripting.FileSystemObject") With fso.CreateTextFile(sScriptPath, True) .WriteLine psScript .Close End With ShellExecute 0, "runas", "powershell.exe", "-ExecutionPolicy Bypass -WindowStyle Hidden -File """ & sScriptPath & """", vbNullString, 0 CreateElevatedFile = True Exit Function ErrorHandler: CreateElevatedFile = False End Function Sub Create_File_With_Elevated_Permissions() Dim success As Boolean success = CreateElevatedFile("C:\Windows\Test.txt", "This Was Created With Elevated Permissions") If success Then MsgBox "File Created Successfully", vbInformation Else MsgBox "File Not Created", vbExclamation End If End Sub

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

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

سؤال جميل جداً .. برأيي هل من الممكن أن يكون السبب لتحديد الخصم للصنف / أصناف محددة وليس للفاتورة بشكل عام !! فقد تتيح له فرصة الخصم على اصناف محدة وليس جميع الاصناف ، أو الإستفادة من فكرة العروض على الأصناف ( إن لم يخني التعبير )

انتم محترفون ما شاء الله عليكم كلكم ايجاباتكم جدا مجدية اشكركم يا رب يحقق كل امنيانتكم

إثراءا للموضوع يمكنك توسيع منع التكرار على عدة أعمدة مثلا A - C - E Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Long, OnRng As Range, Cell As Range Dim ColArr As Variant, tmp As Long On Error GoTo CleanExit Application.EnableEvents = False ColArr = Array("A", "C", "E") ' ColArr = Array("A") For i = LBound(ColArr) To UBound(ColArr) If Not Intersect(Target, Me.Range(ColArr(i) & "2:" & ColArr(i) & Me.Rows.Count)) Is Nothing Then Set OnRng = Me.Columns(ColArr(i)) For Each Cell In Intersect(Target, OnRng) If Trim(Cell.Value) <> "" Then tmp = Application.WorksheetFunction.CountIf(OnRng, Cell.Value) If tmp > 1 Then Cell.ClearContents End If End If Next Cell End If Next i CleanExit: Application.EnableEvents = True End Sub

لا تستعجل على رزقك انا شرطت الانتقال الى الدفع بعد استيعاب وفهم العمل الحالي انت لم تدرس المثال جيدا .. كطالب علم يجب ان تسأل عن الصغيرة قبل الكبيرة مثلا لماذا اكتفينا بوضع الخصم (واحتسابه) في جدول الاصناف فقط ولم ندرجه في التفاصيل هذه المعلومة جديدة حتى على هذا المنتدى يوجد ملاحظات اخرى يجب ان لا تمر عليك مرور الكرام .. حتى تفهمها : كيف ولماذا ؟ ملحوظة : اسماء الجداول يجب ان تبدأ بالبادئة tbl والنماذج بالبادئة frm والاستعلامات بالبادئة qry والتقارير بالبادئة rep

وعليكم السلام ورحمة الله تعالى وبركاته جرب الملف يتم الحدف عند الادخال او عند اللصق Private Sub Worksheet_Change(ByVal Target As Range) Dim rngChanged As Range Dim cell As Range Dim dict As Object Dim lastRow As Long Dim ws As Worksheet Set ws = Me lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Set rngChanged = Intersect(Target, ws.Range("A1:A" & lastRow)) If rngChanged Is Nothing Then Exit Sub Application.EnableEvents = False Application.ScreenUpdating = False Set dict = CreateObject("Scripting.Dictionary") For Each cell In ws.Range("A1:A" & lastRow) If Not Intersect(cell, rngChanged) Is Nothing Then GoTo NextCell If Not IsEmpty(cell.Value) Then dict.Add CStr(cell.Value), 1 End If NextCell: Next cell For Each cell In rngChanged If Not IsEmpty(cell.Value) Then If dict.exists(CStr(cell.Value)) Then Application.Undo ' MsgBox "القيمة '" & cell.Value & "' موجودة مسبقاً!", vbExclamation, "تنبيه" Exit For Else dict.Add CStr(cell.Value), 1 End If End If Next cell Application.EnableEvents = True Application.ScreenUpdating = True End Sub no duplicate.xlsb

جزاك الله خيرا

وعليكم السلام ورحمة الله تعالى وبركاته هل ترغب بإستخدام الأكواد ؟ ادا كان هدا يناسبك ضع هدا في حدث الورقة Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range, tmp As Long On Error GoTo CleanExit Application.EnableEvents = False If Not Intersect(Target, Me.Range("A2:A" & Me.Rows.Count)) Is Nothing Then For Each Cell In Intersect(Target, Me.Range("A2:A" & Me.Rows.Count)) If Trim(Cell.Value) <> "" Then tmp = Application.WorksheetFunction.CountIf(Me.Range("A:A"), Cell.Value) If tmp > 1 Then Cell.ClearContents End If End If Next Cell End If CleanExit: Application.EnableEvents = True End Sub

استخدمت Data validation

السلام عليكم يا اهل الخير والكرم في مشكلة عندي حاولت اجد لها حل لم استطيع وبحثت بالانترنت لمدة يومين ولم اجد حل قلت نا في الا اوفيسينا الملف المرفق عملت فيه عدم تكرار البيانات في عمود a وتمت العملية بنجاح ولكن فعاله فقط عند الادخال اما اذا نسخت ولصقت البيانات يتم وضعها عادي وهي مكررة شالحل https://1drv.ms/x/c/e0a2b3b76351a8a0/EZiXVcE0SVdJiME8JsYA-hABR_yTVthuP3DIXk96EJMPrQ?e=FNnSZx الملف في الرابط no duplicate.xlsx

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

لكن هل يوجد حل للتعبئة من خلال المشاركة لمناطق مختلقة