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

من المعروف ان الدالة Match تعطينا أول صف تراه في الجدول لكن بحيلة بسيطة يمكننا التغلب على هذه الدالة لتعطينا كل الصفوف (كل ذلك دون أخطاء N/A#) شاهد هذا الملف Multi_Match.xlsx

الاخوة الزملاء بناء على سؤال على اليوتيوب ربط خلية في ورقة اكسل لفتح ملف من نوع word ممكن فتح اى ملف غير الورد بعد وضعة فى الفولدر وتغير صيغة الملف كما فى الصورة فتح ملفات pdf ستجد اسفل الموضوع فتح ملف ورد.rar

كود اخر و اقصر (مع عدم السماح بكتابة أكثر او اقل من 11 رقماً في الخلية D8) Option Explicit Private Sub Worksheet_Deactivate() Dim my_rg As Range On Error Resume Next Set my_rg = Sheets("Sheet1") _ .Range("d5:d11").SpecialCells(4) On Error GoTo 0 If Not my_rg Is Nothing Then Sheets("Sheet1").Select MsgBox "There Are Empty Cells:" & my_rg.Address End If End Sub الملف مرفق No_Out_New.xlsm

السلام عليكم ورحمة الله وضعت الكود التالي في حدث الشيت الخاص بالحقول : Private Sub Worksheet_Deactivate() If Application.CountA(Range("D5:D11")) < 7 Then Feuil1.Activate: MsgBox "هناك بعض الحقول فارغة! لا يمكنك الخروج من الشيت" End Sub تجد ذلك في الملف المرفق... بن علية حاجي Book1.xlsm

ربما كان المطلوب هذه المرة tas7i7_Formula.xlsx

بارك الله فيكم جميعا وجزاكم الله كل خير مجهودات ممتازة وعمل رائع

السلام عليكم ورحمة الله أخي سليم، الكود الذي أنجزته رائع جدا والكود الثاني أروع، ولم أكن أعلم أن صاحب الموضوع طلب عناوين الخلايا (الحقول) الفارغة... وقد قمت بالتعديل على الكود السابق بما يلي: Private Sub Worksheet_Deactivate() For I = 1 To 7 If Cells(I + 4, 4) = "" Then S = S & "$D$" & I + 4 & ", " Next If Application.CountA(Range("D5:D11")) < 7 Then Feuil1.Activate: _ MsgBox " : لا يمكنك الخروج من الشيت. هناك حقول فارغة في الخلايا التالية" & Chr(10) & Mid(S, 1, Len(S) - 2) End Sub بن علية حاجي Book1.xlsm

جرب هذا الماكرو Option Explicit Private Sub Worksheet_Deactivate() Dim cont% Dim i%, st$ Dim sh_name$ sh_name = ActiveSheet.Name cont = Application.CountA(Sheets("Sheet1").Range("d5:d11")) If cont <> 7 Then For i = 5 To 11 If Me.Range("d" & i) = vbNullString Then st = st & Me.Range("d" & i).Address & " ," End If Next End If If st <> vbNullString Then Sheets("Sheet1").Select MsgBox "I can't leave the Sheet" & Chr(10) & "We have empty cells, :" _ & Chr(10) & Mid(st, 1, Len(st) - 2) & ".", 64 Else Sheets(sh_name).Select End If End Sub الملف مرفق No_Out.xlsm

الجواب في المرفق وجزاني الله وإياك وكل المسلمين خيرا كميات الاسفلت.xlsx

لا مستحيل عند الاكسل الكود بعد تعديله ليعطي ارتباط تشعبي Option Explicit Sub Give_Data() If ActiveSheet.Name <> "DATA" Then Exit Sub Dim My_Sh As Worksheet Dim Rg_to_Copy As Range Dim cell_to_Copy As Range Dim m%: m = 5 Dim t%, x% Dim start_date As Date: start_date = Sheets("DATA").[c1] Dim final_date As Date: final_date = Sheets("DATA").[c2] With Sheets("DATA") .Range("a5:y" & Rows.Count).ClearContents .Range("a5:y" & Rows.Count).Interior.ColorIndex = 2 For Each My_Sh In Worksheets If My_Sh.Name = "DATA" Or My_Sh.Name = "ملاحظات" Then GoTo 1 Set Rg_to_Copy = My_Sh.Range("a6").CurrentRegion.Offset(1).Columns(1).Cells For Each cell_to_Copy In Rg_to_Copy cell_to_Copy.Resize(, 24).Interior.ColorIndex = 2 If cell_to_Copy.Offset(, 16) >= start_date _ And cell_to_Copy.Offset(, 16) <= final_date Then .Range("a" & m).Resize(, 24).Value = _ cell_to_Copy.Resize(, 24).Value cell_to_Copy.Resize(, 24).Interior.ColorIndex = 6 m = m + 1 t = t + 1 End If Next '======================= If t <> 0 Then x = .Cells(Rows.Count, 1).End(3).Row .Cells(x + 1, 6) = "حصيلة الورقة :" & My_Sh.Name .Cells(x + 1, 1).Resize(, 24).Interior.ColorIndex = 6 '=================== .Cells(x + 1, 10).Hyperlinks.Add Anchor:=.Cells(x + 1, 10), Address:="", _ SubAddress:=My_Sh.Name & "!A1", TextToDisplay:="Go To: " & My_Sh.Name .Cells(x + 1, 10).Font.Size = 16 '=================== m = x + 3 Else End If t = 0 '================= 1: Next End With End Sub الملف جاهز New_جلب حسب التاريخ.xlsm

السلام عليكم ورحمة الله بارك الله فيك أخي سليم، إبداع ما فوقه إبداع... وأقترح تبسيطا (اختصارا) للمعادلة في الخلية E2 (ثم سحبها نزولا): =IF(ROWS($A$1:A1)>COUNTIF($B$2:$B$100;$E$1);"";MATCH(E$1;OFFSET($B$2;SUM(E1);0;ROWS($B1:$B$100)-SUM(E1));0)+SUM(E1)) أو =IF(ROWS($A$1:A1)>COUNTIF($B$2:$B$100,$E$1),"",MATCH(E$1,OFFSET($B$2;SUM(E1),0,ROWS($B1:$B$100)-SUM(E1)),0)+SUM(E1)) بن علية حاجي

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

وعليكم السلام اخى الكريم كان عليك تفقد المنتدى وعمل بحث به فهناك العديد من الموضوعات التى تخدم طلبك ومنها https://www.officena.net/ib/topic/82926-مطلوب-انشاء-ورقه-عمل-مع-الهايبر-لينك-من-عمود-محتوى-على-ارقام-مسلسله/?tab=comments#comment-527624 https://www.officena.net/ib/topic/82985-فتح-شيت-جديد-بمجرد-كتابة-الإسم-فى-خلية/?tab=comments#comment-528117

أحسنت استاذ سليم بارك الله فيك ودائما لنا الفخر من التعلم من حضرتك وم اساتذتنا الكبار

لك ما تريد percent _simple.xlsx

جزاك الله ألف خير فعلا هذا المطلوب واشتغل معاي تمام ألف شكر لك

وعليكم السلام-تفضل find date Total général.xlsm

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

السلام عليكم الطريقة - بيانات ثم التحقق من صحة البيانات ثم قائمة اضغط لاختيار ملف

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

وعليكم السلام تفضل ارشيف.rar

السلام عليكم ورحمة الله تم عمل التعديل في الكود بإضافة أمرين لتحويل التاريخ والمندوب... بن علية حاجي نموذج ادخال.xls

السلام عليكم حل أول بالمعادلات... بن علية حاجي mo.xlsx

سلام عليكم جميعا ممكن شرح طريقة تطبيق هذا الكودعلى الملف المرفق. leave 2.zip

وعليكم السلام ورحمة الله و بركاتة مرفق ملف بعد التعديل اتمنى ان اكون قمت بالمطلوب نسألكم الدعاء leave 2 بعد التعديل.rar

السلام عليكم ورحمة الله هذا كما قال أخي الكريم أحمد يوسف، ما تطلبه ليس بسيطا، ولا أستطيع مساعدتك فيه، لأن كل عنصر من عناصر مكتبة أوفيس (الوورد، إكسيل، أكسس وغيرها) له خصوصية متعلقة بـ VBA وليست من قدراتي ومعرفتي... معذرة على هذا... بن علية حاجي

السلام عليكم ورحمة الله يمكنك استعمال الكود التالي: Sub Close1() For Each WBook In Application.Workbooks WBook.Save Next WBook Application.Quit End Sub ملاحظة: هذا الكود يمكنك وضعته في ملف واحد (منه تُغلق كل الملفات المفتوحة) أو في عدة ملفات (من أيّها تُغلق كل الملفات المفتوحة) مع ربطه بزر للتنفيذ... بن علية حاجي

بارك الله فيك واكثر الله من امثالك وزادك الله من فضله

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

الى كل اخوانى فى المنتدى لقد وفقنى الله لتصميم ملف اكسس بسيط لادارة محل صيانة كمبيوتر حيث يتم تسجيل بيانات الاجهزه والعملاء وتواريخ الاستلام والتسليم لمن اراد ان ينتفع به او لمن يريد ان يطوره لنا ........ تحياتى للجميع بالتوفيق elshazly.rar

هل هذا ما تريده استعلام.mdb

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

وعليكم السلام تفضل find date 0000.xlsm

الله ينور استاذ سليم الكود الثاني تمام اتفضل استاذ ابوعلي الملف بعد اضافة تعديل الكود من الاستاذ سليم جلب حسب التاريخ.xlsm

جرب هيك صديقي ان شاء الله رح يفتح البنوك.accdb

تعديل على الماكرو Option Explicit Sub Give_Data() 'If ActiveSheet.Name <> "DATA" Then Exit Sub Dim My_Sh As Worksheet Dim Rg_to_Copy As Range Dim cell_to_Copy As Range Dim m%: m = 5 Dim t%, x% Dim start_date As Date: start_date = Sheets("DATA").[c1] Dim final_date As Date: final_date = Sheets("DATA").[c2] With Sheets("DATA") .Range("a5:y" & Rows.Count).ClearContents .Range("a5:y" & Rows.Count).Interior.ColorIndex = 2 For Each My_Sh In Worksheets If My_Sh.Name = "DATA" Or My_Sh.Name = "ملاحظات" Then Exit Sub Set Rg_to_Copy = My_Sh.Range("a6").CurrentRegion.Offset(1).Columns(1).Cells For Each cell_to_Copy In Rg_to_Copy cell_to_Copy.Resize(, 24).Interior.ColorIndex = 2 If cell_to_Copy.Offset(, 16) >= start_date _ And cell_to_Copy.Offset(, 16) >= final_date Then .Range("a" & m).Resize(, 24).Value = _ cell_to_Copy.Resize(, 24).Value cell_to_Copy.Resize(, 24).Interior.ColorIndex = 6 m = m + 1 t = t + 1 End If Next '======================= If t <> 0 Then x = .Cells(Rows.Count, 1).End(3).Row .Cells(x + 1, 6) = "حصيلة الورقة :" & My_Sh.Name .Cells(x + 1, 1).Resize(, 25).Interior.ColorIndex = 6 m = x + 3 Else End If t = 0 '================= Next End With End Sub

السلام عليكم أخي لا بد أن تشرح مطلوبك بشيء من التفصيل تقبل تحياتي

عمل رائع وجمييييييل

بعد إذن أستاذى ومعلمى مجدى يونس تفضل الملف EMAIL.xlsx

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

تفضل اخى الكريم Office Soft.Employ & Salary-Source.rar

الخطأ في اسم الحقل في النموذج الثاني عدل سطر الفتح إلى هذا DoCmd.OpenForm "airfare form", , , "[SR-No Leave]=" & SR_No_Leave لاحظ الشرطة بين SR-No لم تكن موجودة وفقنا الله جميعا لكل خير

جرب هذا الملف Vice_versa Hyper.xlsm

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

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

كود اختيار الطابعة Application.Dialogs(xlDialogPrinterSetup).Show

الاخ الحبيب "ابو أحمد" شكرا لتفاعلك مع الموضوع هذا كود وميض نص مع عدة شروط و نطاق من عدة اعمدة وميض3 .rar

السلام عليكم كود لاظهار واخفاء الاعمدة امر واحد يعكس العملية وممكن استخدامه في اكثر من خاصية مشابهة Sub kh_Hidden() With Range("F1,K1,P1,U1,Z1") .EntireColumn.Hidden = Not .EntireColumn.Hidden End With End Sub

كود الأستاذ الحسامي لنقل البيانات تم تعديله ليقوم بنسخ البيانات بدون تفريغ السطر الأصلي لمن يريد ذلك كود لنسخ البيانات - الحسامي.rar