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

طيب مشاركة مع اخوانى الكرام واساتذتى الافاضل بعد التعديلات على الاكواد #If VBA7 Then #If Win64 Then Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr #Else Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long #End If #Else Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long #End If Private Const GW_CHILDREN As Long = 5 Private Const WM_COMMAND As Long = &H111 Private Sub Btn_Hide_Click() Dim toggleDesktopCommand As Long Dim hWnd As LongPtr toggleDesktopCommand = &H7402 hWnd = FindWindow("Progman", "Program Manager") If hWnd <> 0 Then hWnd = GetWindow(hWnd, GW_CHILDREN) If hWnd <> 0 Then SendMessage hWnd, WM_COMMAND, toggleDesktopCommand, ByVal 0& If Btn_Hide.Caption = "Hide Icon" Then Me.Btn_Hide.Caption = "Show Icon" Me.Caption = " Desktop Icon Hide" Else Me.Btn_Hide.Caption = "Hide Icon" Me.Caption = " Desktop Icon Show" End If Else MsgBox "Failed to find child window of Program.", vbExclamation End If Else MsgBox "Failed to find Program window.", vbExclamation End If End Sub Private Sub Form_Load() Me.Caption = "" End Sub Hide Icon Desktop.accdb

الكود يعمل معي على نسخة ويندوز 10 وإصدار أوفيس 64 ، ولكن يبدو انك بحاجة لإضافة PtrSafe لتحويل الكود للعمل على إصدار 64 . والشكر للأستاذ @محمد احمد لطفى على فكرته الجميلة وهذه فكرته لا أتعدى عليه ولا أحصد ثمر مجهوده الثمين ، وإنما بلمستي Hide Icon Desktop.accdb

تفضل جرب هدا Public Sub Filter_data() Dim arrayCriteria(), _ desWS As Worksheet, _ lo As ListObject, _ rng As Range, _ Cpt As Long, _ i As Long Set lo = Range("Clé").ListObject Cpt = lo.ListRows.Count ReDim arrayCriteria(Cpt) For i = 1 To Cpt arrayCriteria(i) = CStr(lo.DataBodyRange.Cells(i, 1)) Next i Set rng = Range("T_data"): Set desWS = Sheets("Feuil2") If WorksheetFunction.CountA(lo.DataBodyRange) = 0 Then MsgBox "المرجوا ادخال معيار الفلترة": Exit Sub With rng.ListObject Application.ScreenUpdating = False If .ShowAutoFilter Then .AutoFilter.ShowAllData .Range.AutoFilter field:=5, Criteria1:=arrayCriteria, Operator:=xlFilterValues If (rng.Rows.Count > 1) Then desWS.Range("d13:k" & Rows.Count).Clear .AutoFilter.Range.Offset(1).SpecialCells(xlVisible).Copy desWS.[D13] [T_data].AutoFilter End If End With Application.ScreenUpdating = True smr.xlsm

شكرا جزيلا استاذي تم و اشتغل الكود نعم الحذف لصف شكرا لاساتذتي Foksh و ابو جودي

فعلاً هذا يعتمد على الهدف من جملة الحذف هل الهدف صف ، أم قيمة معينة

تفضل بالتوفيق Show Hide Icon Desk Top.mdb

اخي الكريم @Mohamed Abo Elala بدايةً هل قمت بتعيين قيمة المتغير قبل البدء بتنفيذ الاستعلام ؟ وهل تم حجز المتغير X كمتغير رقمي بنوع ( Long أو Integer ) . هذا من وجهة نظري ، لعدم وجود مرفق 😊 .

السلام عليكم ورحمة الله تعالى وبركاته اخوانى الكرام اساتذتى الاعزاء الموضوع ده بصراحة كان تحدى بينى وبين نفسي تعبت جدا فكرة الموضوع التقليدية هى التعامل بالارقام واسماء العناصر وكتابة الكثير والكثير من الاكواد والزحمة والحسابات و و وبلا بلا بلا بلا... وفى النهاية يبقى التعديل على العمل بالاضافة او التعديل شئ صعب جدا جدا جدا الا انه بفضل الله اقدم اليكم الفكرة الاتية للتجربة اعتمدت فى المقام الاول على ان تكون الاكواد ثابته بحيث يسهل استخدام الفكرة والطريقة ونقلها لاى قاعدة ولكن عجزت عن تحقيق كل شئ برمجيا وتوقفت وعجزت امام نقطة واحدة ووحيدة ولكن تم التغلب بالفهلوة على المشكلة اترك لكم التجربة وباب النقاش مفتوح بعد ذلك ومن يدرى فد اجد حل للمشكلة التى عجزت امامها معكم وعندكم تعديل جديد بتاريخ 31/05/2024 تم تحديث الموضوع باضافة الاصدار الثانى الذى يعتمد كليا على الوحدات النمطية تم حل جميع المشاكل والعقبات برمجيا والتى واجهتنى بالاصدار الاول على الرغم من انه قد تم التغلب عليها وقتها ولكن بحلول غير برمجية الإصدار الأول : expand and collapse button .accdb الإصدار الثاني (المحسن) : expand and collapse button V2.zip

هذا يعمل عندي بكفاءة 👍🏻

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

العفو اخي يسعدنا اننا استطعنا مساعدتك اليك حل اخر في حالة الرغبة في عدم استخدام الجداول المحورية Sub FiltreListe() Dim srcWS, rCrit, Irow As Long, _ WS As Worksheet, _ desWS As Worksheet, _ ColLast As Long, _ rngFilter As Range, _ i As Long: Cpt = 5: Set WS = Sheets("Feuil1"): Set desWS = Sheets("Feuil2") Irow = WS.Columns("F:F").Find(What:="*", SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row Set rCrit = desWS.[A2:A10]: arr = rCrit.Value srcWS = WorksheetFunction.CountA(desWS.Range("a2:a" & desWS.Rows.Count)) Dim b(): ReDim b(0 To UBound(arr)) On Error Resume Next For i = 0 To UBound(arr) If arr(i, 1) <> "" Then b(i) = CStr(arr(i, 1)) Next i If srcWS = 0 Then MsgBox "المرجوا ادخال عناصر الفلترة" _ & "", vbInformation, "انتباه": Exit Sub ColLast = WS.Cells(1, Columns.Count).End(xlToLeft).Column Set rngFilter = WS.Range(WS.Cells(1, "A"), WS.Cells(1, "H")) 'OR Until the last column 'Set rngFilter = WS.Range(WS.Cells(1, "A"), WS.Cells(Irow, ColLast)) With rngFilter If .AutoFilterMode Then .AutoFilterMode = False .AutoFilter Field:=Cpt, Criteria1:=b, _ Operator:=xlFilterValues j = Application.WorksheetFunction.Subtotal(3, WS.Range("F2:F" & Irow)) If j = 0 Then: MsgBox "لا توجد بيانات ", vbInformation, "تم إلغاء الإجراء": .AutoFilter: Exit Sub desWS.Range("D13:K" & desWS.Rows.Count).Clear WS.AutoFilter.Range.Offset(1).SpecialCells(xlVisible).Copy desWS.[D13] .AutoFilter End With End Sub smr V2.xlsm

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

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

جملة SQL هذه تهدف إلى حذف سجل او سجلات محددة من جدول معين وتحديداحذف السجلات التي يكون فيها قيمة الحقل "id" مساوية للقيمة المخزنة في المتغير "x"

جرب الجملة التالية "DELETE FROM tblBounce WHERE (((tblBounce.id) = " & x & "));"

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

هلا ارسلت مرفق بسيط لرؤيته ؟

أستاذنا @ابو جودي ، أهلاً بعودتك يا صديقي .. عجبتني الفكرة إنك تعمل حفظ لتفاصيل الأزرار عند حدث في الحالي وإنك تستدعيها مرة تانية عند النقر 👌

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

هناك طرق عديدة لذلك حسب قاعدة البيانات لديك :::::: منها استخدم استعلام تحديث

خرجت مع أختها دي IIf(IsNull([YourTextBoxt]),0,([YourTextBox])

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

الف شكر اخي الفاضل جزاك الله خير

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

Not so clear but try this code Sub Test() Dim a, letters, i As Long, ii As Long, k As Long a = Sheet1.Range("C1").CurrentRegion.Value Rem letters = Split("ا,أ,إ,آ", ",") letters = Split("ب", ",") ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2)) For i = 2 To UBound(a, 1) If IsNumeric(Application.Match(Left(a(i, 2), 1), letters, 0)) Then k = k + 1 For ii = LBound(a, 2) To UBound(a, 2) b(k, ii) = a(i, ii) Next ii End If Next i If k > 0 Then With Sheet2 .Columns("C:E").ClearContents .Range("C1").Resize(, 3).Value = Sheet1.Range("C1").Resize(, 3).Value .Range("C2").Resize(k, UBound(b, 2)).Value = b End With End If End Sub

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

رقم 15 هو يوم بداية الاسبوع كما جاء في طلبك اليك المرفق التالي ربما تتضح اليك الفكرة لتساعدك على تحديد الرقم المناسب لك او قم بكتابة تاريخ من اختيارك في الخلية A2 مثلا وجرب استخدام شيئ كهدا Sub TEST() Dim d As Integer d = InputBox("المرجوا ادخال رقم بداية الاسبوع ") Range("C2").Formula = "=weeknum(a2," & d & ")" End Sub '******************************* Sub TEST2() Dim week As Date 'خلية التاريخ week = Range("a2") 'هنا تم تحديد يوم الجمعة كاول يوم في الاسبوع d = 15 st = Application.WeekNum(week, d) MsgBox "رقم الاسبوع هو :" & " " & st, vbInformation End Sub بالتوفيق .... WEEKDAY.xlsx

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

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

هناك كود لإسترجاعها، ولكن الاسهل استعمال البرامج الجاهزة 🙂 جعفر

اعتذر لم اكن اعلم انه ممنوع قمت بمراسلتك على الخاص

تحياتي يالغالي، اذن هنالك طريقة استعادة للجدول، لو تكرمت بكيفية العمل بها نكون شاكرين ودائما منكم نستفيد يالغالي جعفر 🌹🌹 يالغالي قسيم وانا ايظا اتكلم عن الملفات وليس الجداول، حيث الشرح في المثال،، ملف الاكسس A,،، دقيق جدا، تحياتي لك يا استاذنا الغالي 🌹🌹

الاكسس يحتفظ بالبيانات التي تم حذفها، الى ان يقوم المستخدم باستخدام "ضغط واصلاح" ، حينها يحذف الاكسس كل شيء ما عدا البيانات الموجودة ظاهرا امامنا، وكذلك بالنسبة الى كود VBA ، فانه يحتفظ ببعض الاكواد القديمة ، الى ان نعمل Decompile ثم Compile 🙂 جعفر

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

تفضل هذه الاداة تمكنك من استرجاع المحذوف accessfixinstaller.rar

السلام عليكم 🙂 هذا الرابط به برنامج مجاني (للإستعمال الشخصي) لإصلاح ملف اكسس معطوب / تالف جعفر