بحث مخصص من جوجل فى أوفيسنا
![]()
Custom Search
|
كل الانشطه
- الساعة الأخيرة
-
وجدت تغيرات طفيفة في التعديل الاخير مكعوسة وتمت معالجة المشكلة توفي الزوج بعد تاريخ طلاق الزوجة 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 والحمد لله اما بخصوص تنسيق التاريخ تم ايجاد حل عموما شكرا لك استاذي الكريم وربي يحفظك ومايحرمنا من تواجدك معنا ومد يد المساعدة لاخوانك الله يجعلها في ميزان حسناتك ان شاء الله
-
كود لإنشاء ملف نصي في مجلد النظام system
lionheart replied to فتحي محمد's topic in منتدى الاكسيل Excel
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 -
هل جميع الإحتمالات التي تخص هذا الموضوع تمت بنجاح ؟؟؟ موضوع التنسيق الخاص بالتواريخ ضمن ضوابط وشروط محددة ، انصحك بفتح موضوع جديد مستقل له .
-
استدعاء الدالة يا صديقي من خلال زر على سبيل المثال .. في اكسيس ، تم تنفيذها بشكل ميسر ودون اي مشاكل ، أما للفكرة التي في خيالك ان كانت من أجل التفعيل ومنع النقل الغير مصرح به للمشروع ، فيوجد أساليب كثيرة ممكن تطبقها على مشروعك . لست ضليع بالمستوى الذي لدى الأخوة هنا في قسم اكسيل ، ولكني في اكسيس أأكد لك أنه ذلك يسير بطرق وحلول كثيرة وكثيرة وكثيرة ,,
-
سؤال جميل جداً .. برأيي هل من الممكن أن يكون السبب لتحديد الخصم للصنف / أصناف محددة وليس للفاتورة بشكل عام !! فقد تتيح له فرصة الخصم على اصناف محدة وليس جميع الاصناف ، أو الإستفادة من فكرة العروض على الأصناف ( إن لم يخني التعبير )
-
انتم محترفون ما شاء الله عليكم كلكم ايجاباتكم جدا مجدية اشكركم يا رب يحقق كل امنيانتكم
- Today
-
إثراءا للموضوع يمكنك توسيع منع التكرار على عدة أعمدة مثلا 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
-
عدم تكرار البيانات في عمود
عبدالله بشير عبدالله replied to حسين إبن محمد's topic in منتدى الاكسيل Excel
وعليكم السلام ورحمة الله تعالى وبركاته جرب الملف يتم الحدف عند الادخال او عند اللصق 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 -
Muner started following الميزانية الشخصية (هدية مميزة)
-
جزاك الله خيرا
-
وعليكم السلام ورحمة الله تعالى وبركاته هل ترغب بإستخدام الأكواد ؟ ادا كان هدا يناسبك ضع هدا في حدث الورقة 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
-
حسين إبن محمد started following عدم تكرار البيانات في عمود
-
السلام عليكم يا اهل الخير والكرم في مشكلة عندي حاولت اجد لها حل لم استطيع وبحثت بالانترنت لمدة يومين ولم اجد حل قلت نا في الا اوفيسينا الملف المرفق عملت فيه عدم تكرار البيانات في عمود a وتمت العملية بنجاح ولكن فعاله فقط عند الادخال اما اذا نسخت ولصقت البيانات يتم وضعها عادي وهي مكررة شالحل https://1drv.ms/x/c/e0a2b3b76351a8a0/EZiXVcE0SVdJiME8JsYA-hABR_yTVthuP3DIXk96EJMPrQ?e=FNnSZx الملف في الرابط no duplicate.xlsx
-
السلام عليكم شكرا لك استاذ @ابوخليل بارك الله فيك تعبتك معي بقى Payments ماعندي اي فكرة عنه هل التسديد مرتبط باجمالي الفاتورة ام مرتبط باجمالي الدين بصورة عامة وكيف استخرج رصيد الزبون السابق وشكرا
-
لكن هل يوجد حل للتعبئة من خلال المشاركة لمناطق مختلقة
-
أخي الكريم @أحمد عمروف ، تفضل هذا التعديل على التوزيع الشفوي و توزيع اللياقة في زرين منفصلين ، التوزيع الشفهي حسب ما فهمت منك سيكون بتاريخ 31/05/2025 ، واللياقة افترضت تاريخ 10/06/2025 للتجربة ، على العموم ، راقب النتيجة في الجدولين وأخبرني بمدى دقتها أو صحتها أم لا !!!! فكرة توزيع تلقائي لمستويين (2).zip
-
تمام ، بناءً على كلامك ، سيكون التعديل كالتالي ، وأنصح بدراسة وتجربة جميع الإحتمالات حتى تلم بها دون اي مشاكل .. استبدل التعديل السابق بالتالي في التقرير :- Private Sub ProcessNoRemarriageCertificate() Me.L3.Visible = False Me.L2.Visible = True Me.L1.Visible = True Call InitializeControlsVisibility Dim zawjValue As Integer, zawjaValue As Integer zawjValue = Nz(Me.Tbl_ZAWJ_Hamech.Value, 0) zawjaValue = Nz(Me.Tbl_ZAWJA_Hamech.Value, 0) Dim dateDivorce As Date, dateDeath As Date On Error Resume Next dateDivorce = Nz(DLookup("[تاريخ (الوفاة - الطلاق)]", "N_Mariag"), 0) dateDeath = Nz(DLookup("[تاريخ الوفاة]", "N_Mariag"), 0) On Error GoTo 0 Select Case True ' حالة "لم تطلق منذ زواجها" Case (zawjValue = 1 And zawjaValue = 1) Me.k5.Visible = False Me.Da5.Visible = True Me.Za5.Visible = True ' حالة "عدم إعادة الزواج وهي أرملة" Case (zawjValue = 2 And zawjaValue = 1) Me.k6.Visible = False Me.Da6.Visible = True Me.Za6.Visible = True ' حالة "عدم إعادة الزواج وهي مطلقة" Case (zawjValue = 1 And zawjaValue = 2) Me.k7.Visible = False Me.Da7.Visible = True Me.Za7.Visible = True ' حالة "الزواج المنعقد بين السيد والسيدة" Case (zawjValue = 1 And zawjaValue = 1) Me.k8.Visible = False Me.Za8.Visible = True Me.Com8.Visible = True Me.Ne8.Visible = True ' الحالة الجديدة أخي طاهر عندما يكون الزوج متوفي والزوجة مطلقة (zawjValue = 2 And zawjaValue = 2) Case (zawjValue = 2 And zawjaValue = 2) If dateDeath > dateDivorce And dateDivorce <> 0 And dateDeath <> 0 Then ' إذا توفي الزوج بعد تاريخ طلاق الزوجة 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 End If End Select DoCmd.Close acForm, "A3" End Sub Private Sub InitializeControlsVisibility() Dim controlNames As Variant controlNames = Array("k5", "Da5", "Za5", "k6", "Za6", "Da6", _ "k7", "Za7", "Da7", "k8", "Za8", "Com8", "Ne8", _ "k1", "Za1", "Da1", "k2", "Za2") Dim ctrlName As Variant For Each ctrlName In controlNames On Error Resume Next Me.Controls(ctrlName).Visible = (Left(ctrlName, 1) = "k") On Error GoTo 0 Next ctrlName End Sub
-
شكرا استاذي على التعديل الجميل ربي يجازيك ويبارك في عملك الان في نظري الحالة الاخيرة تكون ساهلة حسب تبسيط الكود الزوج متوفي والزوجة مطلقة اي الهامش2 و 2 علمنا ان الطلاق قبل الوفاة هنا تطبق الحالة7 "لم تتزوج منذ طلاقها من زوجها السيد " نذهب الى الحالة التي بين ايدينا ركز معي حالة نور الدين قسومة الطلاق من هنيه فقير يوم 1998/02/26 والوفاة يوم 2000/05/01
-
أخي @طاهر اوفيسنا ، توضيحك للقيم الخاصة بالهامش في الجداول جاءت لك بفائدة كبيرة وهذا الى حد ما جزء من التأسيس الصحيح . تم استخدام هياكل تحكم أفضل من الجمل الشرطية . حيث استبدلت عبارات If-ElseIf المتعددة ببنية Select Case أكثر وضوحاً واستقرار مع دالة مساعدة بسيطة ، في المرفق التالي :- فتح تقرير FACE15.zip وفي الواقع انا تلافيت التعديل والعبث في مكونات جداولك بعد تعليقك على تعديلاتي في التقرير 😅 . ردك جعلني أتراجع عن المتابعة الى حد ما سابقاً ولكن الحمد لله تيسرت بطريقتك المشروعة .
-
استاذي العزيز فما محاولة لي بدالة IF تفي بالغرض المطلوب ياريت تتطلع عليها واذا رأيت اختصارات فقم باللازم فتح تقرير FACE15.rar
-
اخي واستاذي @Foksh اولا لكم مني جزيل الشكر على مرورك الكريم وسرعة الاستجابه هذا بالفعل هوا المطلوب
-
جزاك الله خيرا
-
لماذا اعادة البناء استاذ انت عدل عمل التقرير على ثلاثة حالات فقط ملاحظة : لا تتبع الامثلة الاخيرة التي ارفقتها بخصوص الهوامش واتبع مايلي : الحالة الاولى : الزوج متوفي هامش الزوج يحمل رقم 2 يعني الزوجة ارملة " لم تتزوج منذ وفاة زوجها السيد ......... المتوفي بتاريخ ........" العنوان (عدم إعادة الزواج 3) الحالة الثانية : الزوجة مطلقة هامش الزوجة يحمل رقم 2 يعني حالة طلاق "لم تتزوج منذ طلاقها من السيد ..........بتاريخ ........." العنوان (عدم إعادة الزواج 3) الحالة الثالثة : الزوجة على قيد الحياة وغير مطلقة هامش الزوجة يحمل رقم 1 يعني حالة زواج " لم تطلق منذ زواجها بالسيد .......... بتاريخ ............" العنوان (عدم الطلاق 2) هذا مافي الامر ارجو ان اكون بسطت لك الفكرة وان شئت اقرن بدالة IF الشرطية الحالات بالهامش 1- الزوج حالة 2 والزوجة حالة 1 2- الزوج حالة 1 والزوجة حالة 2 3- الزوج حالة 1 والزوجة حالة 1
-
اخي و استاذي @أبو إبراهيم الغامدي اولا لكم مني جزيل الشكر على مرورك الكريم وسرعة الاستجابه هذا بالفعل هوا المطلوب