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

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

وعليكم السلام-بارك الله فيك وزادك الله من فضله

وعليكم السلام -تفضل كان عليك استخدام خاصية البحث بالمنتدى تحديد طابعة معينة للطباعة في الكود وهذا فيديو اخر للتوضيح للأستاذة ساجدة العزاوى لها منا كل المحبة والإحترام

لطلبك هذا لابد من استخدام هذه المعادلة =IFERROR(IF(AND(COUNTIF($B$4:B4,B4)=1,U4=0),VLOOKUP($B4,$U$1:$V$2,2,0),IF(AND(COUNTIF($B$4:B4,B4)>1,U4=0),VLOOKUP($B4,$U$1:$V$2,2,0)+(COUNTIFS($B$4:B4,B4,$U$4:U4,U4)-1),"")),"") ترقيم وتسلسل1.xlsx

أخى الكريم تفضل الخطأ كان من عندك انت... فلابد ان تكون ادخالات الوقت صحيحة كصيغة وقت وليست نص بــــ Sheet1 help count late1.xlsx

أخى الكريم لا يوجد مشكلة بالمعادلة فالمشكلة لديك انت عند كتابة الوقت , فاذا كنت تريد كتابة الساعة 01 بعد منتصف الليل فجرب كتابتها هكذا وستجد النتيجة المرجوة 25:00 1.xlsx

الكود من المنتدى لاستاذنا عبدالله باقشير ملف2.xlsb

الاساتذة الافاضل Ali Mohamed Ali حسين مامون ابو يحيى1 سليم حاصبيا ابراهيم الحداد abouelhassan محمد حسن المحمد yara ahmed محمد يوسف فوزى فوزى ashraf_abdalla ابو طيبه بارك الله في الجميع واشكركم جميعا على هذه الثقة وادعو الله ان اكو ن في مستوى المسئولية حفظكم الله جميعا

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

في هذه الحالة لا حاجة للفلتر (معادلة بسيطة) Fahd.xlsx

للمرة الــ 100 بعد الألف (يجب ان يكون الجدول مستقلاً عن كل الخلايا التي لا علاقة له بها 1- للمرة الأخيرة اقوم بالمساعدة دون هذه الميزة (تم ادراج صف فارغ لتحقيق ذلك الصف رقم 3 مخفي) الكود Sub Salim_Macro() Application.ScreenUpdating = False Dim My_max% Dim Cont As Integer Dim Ro Cont = Range("H1").Value My_max = Range("A4").CurrentRegion.Rows.Count If My_max = 1 Then GoTo End_Me With Range("A4").CurrentRegion. _ Offset(1).Resize(My_max - 1) _ .Columns(1) .ClearContents .Offset(, 7).ClearContents End With With Range("B4:H" & My_max + 3) .Sort .Columns(4), xlAscending, Header:=1 .Sort .Columns(3), xlAscending, Header:=1 .Sort .Columns(6), xlDescending, Header:=1 End With Range("a5").Resize(My_max - 1) = _ Evaluate("Row( 1:" & My_max - 1 & ")") Range("H5").Resize(My_max - 1).Formula = _ "=INT((ROWS($A$1:A1)-1)/" & Cont & ")+1" Range("A4:H" & My_max).Value = _ Range("A4:H" & My_max).Value End_Me: Application.ScreenUpdating = True End Sub الملف مرفق Moustsfa_Sort.xlsm

جرب الماكرو هكذا ربما يفي بالغرض Sub Macro1() Application.ScreenUpdating = False Dim Cont As Integer Dim lr Cont = Range("h1").Value lr = Range("b" & Rows.Count).End(xlUp).Row With Range("b4:h" & lr) .Sort .Columns(4), xlAscending .Sort .Columns(3), xlAscending .Sort .Columns(6), xlDescending End With With Range("h4:h" & lr) .FormulaR1C1 = "=MOD(ROW()-4," & Cont & ")+1" .Value = .Value End With With Range("b4:h" & lr) .Sort .Columns(7), xlAscending End With Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله جرب هذا الكود Sub GetName() Dim ws As Worksheet, Arr As Variant Dim LR As Long, i As Long Dim j As Long, x As Long Application.ScreenUpdating = False Set ws = Sheets("ورقة2") LR = ws.Range("A" & Rows.Count).End(3).Row Arr = ws.Range("A13:AA" & LR).Value x = 3 Do While x <= 27 For i = 1 To UBound(Arr, 1) For j = 1 To UBound(Arr, 2) If ws.Cells(1, x) = Arr(i, j) Then ws.Cells(2, x) = Arr(i, 1) End If Next Next x = x + 1 Loop Application.ScreenUpdating = True End Sub

الف مبروك تستاهلوا كل خير وفقكم الله واعانكم

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

تفضل لك كل ما طلبت حسابات العملاء 1.xlsx

وعليكم السلام-اهلا بك فى المنتدى -تفضل لك ما طلبت المصنف1 1.xlsx

وعليكم السلام عليك بتتبع هذه الفيديوهات فستدلك على افضل الطرق تحويل الاسماء من العربي للانجليزى تلقائيا اكسل ترجمة الاسماء_تحويل كم كبير من الأسماء المكتوبة باللغة العربية إلى الانجليزية بضغطة زر

تفضل Convert exe to xls

وعليكم السلام -يمكن جعل الأكواد هكذا Private Sub Option2_Click() If Option2.Visible = True Then frm1.Hide Sheets("Ý.1.Ë.Ú").Visible = True Sheets("Ý.1.Ã").Visible = False Sheets("Ý.1.Ë.Ã").Visible = False End If End Sub Private Sub Option1_Click() If Option1.Visible = True Then frm1.Hide Sheets("Ý.1.Ã").Visible = True Sheets("Ý.1.Ë.Ú").Visible = False Sheets("Ý.1.Ë.Ã").Visible = False End If End Sub Private Sub Option3_Click() If Option3.Visible = True Then frm1.Hide Sheets("Ý.1.Ë.Ã").Visible = True Sheets("Ý.1.Ã").Visible = False Sheets("Ý.1.Ë.Ú").Visible = False End If End Sub التنقل بين الصفحات.xlsb

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

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

فى مشكلة فى المرفق ولاحظ كلمة Unavailable

الحل كما ارفقت لحضرتك انك كنت مش معرف زر choise فى الجدول Table1 انا ضفته فى الجدول والاستعلام وهكذا تقدر تتعامل مع البيانات بالتوفيق اخى وانا تحت امرك فى اي معلومه تريدها

تفضل أستاذ في المثال دالتان معرفتان الدالة الأولى لتفقيط الوقت الدالة الثانية لتفقيط مجموع الوقت دالة تفقيط الوقت.xls

إليك الدالة المعرفة TimeToLettre الدالة تعمل إلى غاية "99:99:99" وتعمل للساعات فقط أو الدقائق فقط أو الثواني فقط Function TimeToLettre(Time As Variant) As String ' Created By Benkhalifa Djemoui ' Algeria: 05-12-2020 Dim MyHour As Variant Dim MyMinute As Variant Dim MM, HH, SS As String Dim H, M, S As Byte '=============================================================================================================================== MyHour = Array("", "ساعة", "ساعتان") '=============================================================================================================================== MyMinute = Array("صفر", "دقيقة", "دقيقتان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _ "عشر", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر", _ "عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _ "سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", _ "ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _ "خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", _ "أربعون", "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _ "سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", _ "خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _ "خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", _ "ستون", "واحد و ستون", "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", _ "خمسة و ستون", "ستة و ستون", "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", _ "سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", "أربعة و سبعون", _ "خمسة و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", _ "ثمانون", "واحد و ثمانون", "إثنان و ثمانون", "ثلاثة و ثمانون", "أربعة و ثمانون", _ "خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", "ثمانية و ثمانون", "تسعة و ثمانون", _ "تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _ "خمسة و تسعون", "ستة و تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون") '=============================================================================================================================== Time = Split(Time, ":") H = Int(Time(0)) M = Int(Time(1)) S = Int(Time(2)) '=============================================================================================================================== If H = 0 Then GoTo Minute Select Case H Case 1 To 2: Select Case M: Case 0: HH = MyHour(H): Case Else: HH = MyHour(H) & " و ": End Select Case 3 To 10: Select Case M: Case 0: HH = MyMinute(H) & " ساعات ": Case Else: HH = MyMinute(H) & " ساعات و": End Select Case 11 To 99: Select Case M: Case 0: HH = MyMinute(H) & " ساعة ": Case Else: HH = MyMinute(H) & " ساعة و ": End Select End Select '=============================================================================================================================== Minute: If M = 0 Then GoTo Second If M <> 15 And M <> 30 Then Select Case M Case 1: Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select Case 2: Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select Case 3 To 10: Select Case S: Case 0: MM = MyMinute(M) & " دقائق ": Case Else: MM = MyMinute(M) & " دقائق و ": End Select Case 11 To 59: Select Case S: Case 0: MM = MyMinute(M) & " دقيقة ": Case Else: MM = MyMinute(M) & " دقيقة و ": End Select End Select '=============================================================================================================================== Else If H <> 0 Then Select Case M Case 15: Select Case S: Case 0: MM = " ربع ": Case Else: MM = " ربع و ": End Select Case 30: Select Case S: Case 0: MM = " نصف ": Case Else: MM = " نصف و ": End Select End Select Else Select Case M Case 15: Select Case S: Case 0: MM = " ربع ساعة ": Case Else: MM = " ربع و ": End Select Case 30: Select Case S: Case 0: MM = " نصف ساعة ": Case Else: MM = " نصف و ": End Select End Select End If End If '=============================================================================================================================== Second: If H <> 0 Or M <> 0 Then Select Case S Case 1: Select Case M: Case 0: SS = " و ثانية": Case Else: SS = " ثانية": End Select Case 2: Select Case M: Case 0: SS = " و ثانيتان": Case Else: SS = " ثانيتان": End Select Case 3 To 10: Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثوان": Case Else: SS = MyMinute(S) & " ثوان": End Select Case 11 To 59: Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثانية": Case Else: SS = MyMinute(S) & " ثانية": End Select End Select '=============================================================================================================================== Else Select Case S Case 1: SS = "ثانية" Case 2: SS = "ثانيتان" Case 3 To 10: SS = MyMinute(S) & " ثوان" Case 4 To 59: SS = MyMinute(S) & " ثانية" End Select End If '=============================================================================================================================== TimeToLettre = Trim(HH) & " " & Trim(MM) & " " & Trim(SS) '=============================================================================================================================== Erase MyHour, MyMinute End Function

مجدداً حلايا لا علاقة لها بالجدول تضاف اليه هذا الملف يحتوي على صفحتين (اختر ما تريد ) كل واحد الماكرو الخاص بها My_test.xlsm

جرب هذا الكود Option Explicit Sub filter_me() Dim T As Worksheet Dim S As Worksheet Dim Rg As Range Dim Ro Dim cret$ Set S = Sheets("Source") Set T = Sheets("Target") Set Rg = S.Range("E2").CurrentRegion S.AutoFilterMode = False T.Range("E2").CurrentRegion.Clear cret = T.Range("A1") Rg.AutoFilter 3, cret Rg.SpecialCells(12).Copy With T.Range("E2") .PasteSpecial (4) .PasteSpecial (12) End With S.AutoFilterMode = False Application.CutCopyMode = False Ro = T.Range("E2").CurrentRegion.Rows.Count If Ro > 1 Then T.Range("E3").Resize(Ro - 1) = _ Evaluate("Row(1:" & Ro - 1 & ")") End If T.Range("E2").Select End Sub الملف مرفق f16.xlsm

الف الف مبروووك للأساتذة الاعزاء الترقية الله يحفظكم ويبارك بيكم

لا بمكن جذف خلية (أو أكثر ) منفردين من الأكسل ) ماذا ستضع مكانها ؟؟؟ لقاح لفيروس كورونا مثلاً لذلك هناك خياران: 1- أمّا ان تجذف صف (أو عدة صفوف )بكاملها 2- أمّا عامود ( أو عدة اعمدة ) بكاملها

وعليكم السلام ورحمه الله وبركاته نورت استاتذي الغالي بعد اذن استاتذتي الكرام بدلي بدلوي Call Me.TB.Form.zr_7_Click هذا اذا كان الكود بزر واسمه مثلاzr_7 بالفرعي وتريد تشغله من النموذج الرئيسي واذا لديك مثلا ارفقه راح نبحث ونلف المنتدي حتا نجد طلبك يالغالي ابشر بالفزعه ياصاحب الجميل تحياتي اليك وللاستاتذه الكرام ابو زاهر

الشكر لله اخي الطريقة اننا قمنا بعد سجلات الجدول باستخدام دالة DCount عن طريق شرطين الاول ان يكون القسم يساوي القسم والشرط الثاني ان يكون حقل الحالة فارغ لكن لدي سؤال ادريا من خرج من العمل باذن لا يعتبر غائب عن العمل و لو اردنا اعتبار باذن من ضمن الحضور حينها سنجد ان الطريقة لن تعمل بشكل صحيح وسوف نستخدم طريقتين اخرى سوف ارفقها لك ولكل من قد يجد المثال نافعا الطريقة الاولى بان نجعل مصدر التقرير استعلام ونعمل فيه حقل محسوب قيمته تساوي وبالتالي يتم تسجيل عبارة حاضر بشكل تلقائي في التقرير اذا كان حقل الحالة فارغ Status2: Nz([Status];"حاضر") في حقل عدد الحضور في التقرير نجعل قيمته تساوي =DCount("*";"q_1";"[dept]='" & [Dept] & "'" & "and status2 <>'غائب'") وتفسيرة قم بعد الحقول في الاستعلام اذا كان القسم يساوي القسم وحالة الموظف لا تساوي غائب والنتيجة Employees1.accdb

أ.بوكفوس عبدالسلام مجرد محاولة والله أعلم .. افتح نسخة من قاعدة البيانات علي اي جهاز آخر يعمل بنظام 64 بت واذهب لمحرر فيجوال بيسك وابحث عن (PtrSafe ) فى كامل المشروع وقم بإلغائها .. إحفظ وأغلق القاعدة وأعد فتحها على الجهاز الذى يعمل فى بيئة 32 بت .. عسى ان تلبي الغرض بالتوفيق

كاسم المستلم مثلا او المستلم + المشروع معا لم أر المستلم ولا المشروع في الجدول فهل المستلم هو المستفيد والمشروع هو الموقع ام بالعكس جرب هذا الملف (صفحة One For_All ) الملف مرفق Option Explicit Dim DC As Object Dim DD As Object Dim D_Sh As Object Dim O As Worksheet Dim sh As Worksheet Dim i, Max_ro%, m% '++++++++++++++++++++++++++++++ Private Sub Worksheet_Activate() data_val End Sub '++++++++++++++++++++++++++ Sub MY_choose() Select Case Sheets("One For_All").Range("G2") Case "E": Filter_Only_E Case "D": Filter_Only_D Case "D+E": Filter_C_And_D Case Else: Exit Sub End Select End Sub '++++++++++++++++++++ Sub data_val() Set O = Sheets("One For_All") Set DC = CreateObject("Scripting.Dictionary") Set DD = CreateObject("Scripting.Dictionary") Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row For i = 2 To Max_ro DC(Sheets("Payments").Cells(i, "C").Value) = vbNullString DD(Sheets("Payments").Cells(i, "D").Value) = vbNullString Next With O.Range("D2").Validation .Delete .Add 3, Formula1:=Join(DC.keys, ",") End With With O.Range("E2").Validation .Delete .Add 3, Formula1:=Join(DD.keys, ",") End With End Sub '+++++++++++++++++++++++++++ Sub Filter_Only_E() Set O = Sheets("One For_All") If O.Range("C4").CurrentRegion.Rows.Count > 1 Then O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion. _ Rows.Count - 1).Clear End If Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row m = 5 If O.Range("E2") = vbNullString Then Exit Sub For i = 2 To Max_ro If Sheets("Payments").Cells(i, "D") = O.Range("E2") Then O.Cells(m, 3) = m - 4 O.Cells(m, 4).Resize(, 5).Value = _ Sheets("Payments").Cells(i, 2).Resize(, 5).Value m = m + 1 End If Next If O.Range("C4").CurrentRegion.Rows.Count > 1 Then With O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .Interior.ColorIndex = 35 .InsertIndent 1 End With End If End Sub '+++++++++++++++++++++++++++++++++++ Sub Filter_Only_D() Set O = Sheets("One For_All") If O.Range("C4").CurrentRegion.Rows.Count > 1 Then O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion. _ Rows.Count - 1).Clear End If Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row m = 5 If O.Range("D2") = vbNullString Then Exit Sub For i = 2 To Max_ro If Sheets("Payments").Cells(i, "C") = O.Range("D2") Then O.Cells(m, 3) = m - 4 O.Cells(m, 4).Resize(, 5).Value = _ Sheets("Payments").Cells(i, 2).Resize(, 5).Value m = m + 1 End If Next If O.Range("C4").CurrentRegion.Rows.Count > 1 Then With O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .Interior.ColorIndex = 35 .InsertIndent 1 End With End If End Sub '++++++++++++++++++++ Sub Filter_C_And_D() Set O = Sheets("One For_All") If O.Range("C4").CurrentRegion.Rows.Count > 1 Then O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion. _ Rows.Count - 1).Clear End If Max_ro = Sheets("Payments").Cells(Rows.Count, 2).End(3).Row m = 5 If O.Range("D2") = vbNullString Or _ O.Range("E2") = vbNullString Then Exit Sub For i = 2 To Max_ro If Sheets("Payments").Cells(i, "C") = O.Range("D2") And _ Sheets("Payments").Cells(i, "D") = O.Range("E2") Then O.Cells(m, 3) = m - 4 O.Cells(m, 4).Resize(, 5).Value = _ Sheets("Payments").Cells(i, 2).Resize(, 5).Value m = m + 1 End If Next If O.Range("C4").CurrentRegion.Rows.Count > 1 Then With O.Range("C4").CurrentRegion.Offset(1). _ Resize(O.Range("C4").CurrentRegion.Rows.Count - 1) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .Interior.ColorIndex = 35 .InsertIndent 1 End With End If End Sub Hisabat_Super.xlsm

شكرا جزيلا .. على القائمين على هذا الصرح .. الكبير .. تمنياتي للجميع بالتوفيق دائما .. بارك الله فيكم ..

السلام عليكم ورحمة الله وبركاته ليس بعد كلام أستاذنا جعفر كلام - ولكن أطرح فكرة أخري من وجهة نظري القاصرة أفظل أستخدام اسكربت يقوم بهذه المهمة بسبب: أولا- حجمه الصغير الذي يكاد يكون معدوم ، ثانيا- لكونه لا يحتاج لاعدادات اضافية لتشغيله؛ بمعني لو قمت بتنفيذ هذا الكود من قاعدة بيانات علي قاعدة بيانات أخري كان لزاما أن يتم تخفيض الأمان لتعمل قاعدة البيانات الأولي أولا حتي تعمل. (خاصة اذا كان هذا الكود سيعمل علي جهاز العميل) ؛ وهذا الشئ غير موجود مع الاسكربت. وأخيرا- هذا هو الكود داخل الاسكربت يمكنك التعديل عليه وفقا لاحتياجاتك. Rem This is the beginning of the code: Call Createadbe Sub Createadbe() On Error Resume Next dim fso dim mePath Set fso = CreateObject("Scripting.FileSystemObject") mePath = fso.GetAbsolutePathName(".") Rem here we test if accde file is exist And delete it if it is exist Rem==================================================================== if fso.FileExists(mePath & "\Write Here Your accde file Name")= True then fso.DeleteFile mePath & "\Write Here Your accde file Name" end if Rem Here Test if our accdb file is Exist and get started Rem====================================================== If fso.FileExists(mePath & "\Write Here Your accdb file Name")= True then With Createobject("Access.Application") .AutomationSecurity = 1 .SysCmd 603, mePath & "\Write Here Your accdb file Name", mePath & "\Write Here Your accde file Name" .Quit End With MsgBox "Conversion Done Successfully!" fso.DeleteFile mePath & "\Write Here Your accdb file Name" Else msgbox "Conversion Not Done; Some file Not Exists!" End If Rem Now kill My silf: Rem================== if err.number <> 0 then with fso If .FileExists(mePath & "\Write Here Your accdb file Name") then .DeleteFile(mePath & "\Write Here Your accdb file Name") If .FileExists(mePath & "\Database.accdb") then .DeleteFile(mePath & "\Database.accdb") If .FileExists(mePath & "\Database.mdb") then .DeleteFile(mePath & "\Database.mdb") If .FileExists(mePath & "\ConversionAccdbToAccde.vbs") then .DeleteFile(mePath & "\ConversionAccdbToAccde.vbs") end with end if End sub اذا كنت لا تدري عن صناعة الاسكربت فهو ملف txt عداي تقوم بنسخ الكود بأعلاه مع تغير الجمل Write Here Your accdb file Name الي اسم الملف الخاص بحضرتك Write Here Your accde file Name الي اسم الملق الخاص بحضرتك ثم تقوم بحفظ الملف txt بصيغة vbs وفقط وانتهي الأمر لحظة ضع ملف الاسكربت مع الملف المراد تحويله في نفس الفولدر ثم قم بالضغط عليه مرتين وانظر ماذا يحدث ولا تنسي تأخذ نسخة احتياطية من ملف الاسكربت لأنه سيقوم بحذف نفسه بعد الانتهاء. هذا كل شىء مع تمنياتي بالتوفيق هذا هو الاسكربت ConversionAccdbToAccde.rar

تفضل يا سيدي ، الكود السابق بواجهه : . جعفر Convert_mdb _n_accdb_to_mde_n_accde.mdb.zip

السلام عليكم ورحمة الله وبركاته أخي العزيز أبو عاصم المصري، تم تنفيذ هذا الاقتراح وفق الإستراتيجية التي اتفقنا عليها، يرجى مشاهدة الفيديو التالي: [الجديد في التحديث 4.50]: 1- في خاصية بحث في ملفات متعددة، أصبحت العملية تتم على ملفات وورد القديمة التي بامتداد doc أيضاً، وبذلك فإن البحث سيتم ضمن كل إصدارات وورد القديمة والحديثة، سواء كان امتدادها docx أو doc. 2- في الفهرسة اليدوية، تم إضافة خاصية فهرسة الأعلام والأماكن والمصطلحات وما شابهها بطريقة شبه آلية.

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

تم التعديل الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Rg As Range, F_rg As Range Application.EnableEvents = False Set Rg = Union(Range("C3:C20"), Range("E3:E20"), Range("G3:G20")) If Not Intersect(Target, Rg) Is Nothing _ And Target.Cells.Count = 1 Then Set F_rg = Range("B42:B57").Find(Target, lookat:=1) If Not F_rg Is Nothing Then Target = Cells(F_rg.Row, "C") End If End If Application.EnableEvents = True End Sub Talal_1.xlsm

جرب هذا الكود اذا لم تظهر القائمة المنسدلة (في الشيت Result) غادر الصفجة ثم عد اليها مجدداً Ihab.xlsm

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

وعليكم السلام وبما انك لم تقم برفع ملف فكان عليك استخدام خاصية البحث بالمنتدى فبه طلبك تفضل فورم اضافة وبحث وحذف وتعديل واغلاق وطباعة بدون ازرار أويمكنك متابعة هذا الفيديو فبه طلبك طباعة الفورم userform مع اخفاء الازرار vba excel - commandbutton

بعد اذن الأستاذ سـلـيم وزيادة فى اثراء الموضوع بدون اخفاء شريط الصيغة ... يمكنك وضع هذا الكود فى حدث الصفحة Dim xDic As New Dictionary Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim xCell As Range Dim xRg As Range Set xRg = Range("b2:b100") If xDic.Count <> xRg.Count Then For Each xCell In xRg xDic.Add xCell.Address, xCell.FormulaR1C1 Next End If If (Target.Count = 1) And (Not Application.Intersect(xRg, Target) Is Nothing) And (Target.HasFormula) Then With Target .Value = .Value End With Else For Each xCell In xRg xCell.Formula = xDic.Item(xCell.Address) Next End If End Sub

تفضل بعد اذن الأستاذ سليم طبعاً يمكنك عملها بنفسك بهذه المعادلة =SUMIFS('1'!$D$4:$D$270,'1'!$B$4:$B$270,">="&$F$5,'1'!$B$4:$B$270,"<="&$H$5,'1'!$C$4:$C$270,$B7,'1'!$A$4:$A$270,$D$6)

أحسنت استاذ جلال عمل ممتاز جعله الله فى ميزان حسناتك

وعليكم السلام -اهلا بك اخى الكريم فى المنتدى لماذا لا تستخدم خاصية البحث فى المنتدى -يمكنك هذا بعد اضافة أداة Solver وطالما انك لم تقم برفع ملف فيمكنك متابعة ومشاهدة هذه المشاركة بها رد لما تحتاجه https://www.officena.net/ib/topic/85879-معادلة-جمع-بعض-الارقم-التى-تحقق-ناتج-معين/?tab=comments#comment-544482 بارك الله فيك

بارك الله فيك أستاذ محمد وجعله الله فى ميزان حسناتك

وعليكم السلام-اجعل المعادلة هكذا =IF(A2="","",NETWORKDAYS.INTL(A2,TODAY(),7)) 1تاريخ البدء.xlsx

وعليكم السلام-تفضل ما تريد بالتنسيقات الشرطية. وتم ايضاً لعمل قائمة منسدلة لإختيار الحروف المطلوبة نظام التقييم للصف االاول بالألوان1.xlsx