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

وعليكم السلام 🙂 كود اخوي موسى ، ولكن بطريقتي 🙂 Sub CopyFile() Dim sPathDeskTop As String sPathDeskTop = Environ("USERPROFILE") & "\Desktop" & "\b\" ' هنا اسم المجلد الذي سيتم انشاؤه في سطح المكتب Dim CopyFrom As String, CopyTo As String CopyFrom = Me.a ' هذا اسم الحقل الذي به رابط الملف المراد نسخه CopyTo = sPathDeskTop & Dir(CopyFrom) If Len(Dir(sPathDeskTop, vbDirectory)) = 0 Then MkDir (sPathDeskTop) If Len(Dir(CopyTo, vbDirectory)) = 0 Then FileCopy CopyFrom, CopyTo Else MsgBox "هذا الملف موجود مسبقا على سطح المكتب", vbOKOnly Exit Sub End If End Sub جعفر

وعليكم السلام ورحمة الله وبركاته .. تفضل أخي العزيز 🙂 Sub CopyFile() 'Requires reference: :لابد من التأكد من وجود المكتبة الاتية 'Add this reference >>---> Microsoft Scripting Runtime Dim fs Set fs = CreateObject("Scripting.FileSystemObject") Dim sPathDeskTop As String Dim oWSH As Object Set oWSH = CreateObject("WScript.Shell") sPathDeskTop = oWSH.SpecialFolders("Desktop") & "\b\" ' هنا اسم المجلد الذي سيتم انشاؤه في سطح المكتب Dim CopyFrom As String, CopyTo As String CopyFrom = Me.a ' هذا اسم الحقل الذي به رابط الملف المراد نسخه CopyTo = sPathDeskTop & Dir(CopyFrom) If Len(Dir(sPathDeskTop, vbDirectory)) = 0 Then MkDir (sPathDeskTop) If Len(Dir(CopyTo, vbDirectory)) = 0 Then fs.CopyFile CopyFrom, CopyTo, True Else MsgBox "هذا الملف موجود مسبقا على سطح المكتب", vbOKOnly Exit Sub End If Set fs = Nothing Set oWSH = Nothing End Sub فقط انتبه للملاحظات المكتوبة في الكود ..

السلام عليكم و رحمة الله اتمنى ان يكون هذا ما تصبو اليه Sub try01() Dim r, r2, x, l As Long Dim ws As Worksheet ' [هذه العبارة تم اضافتها حتى يعمل معك الكود من اى ورقة Set ws = Sheets("summare ") ' اسم الورقة التى سوف يتم العمل عليها ws.Range("b7:o1000") = "" ' محو البيانات القديمة x = ThisWorkbook.Sheets.Count ' عدد الشيتات فى الملف r = 7 ' الصف الذى سوف يبدأالعمل من خلاله For i = 3 To x ' ترتيب الشيتات التى سوف يتم استيراد البيانات منها 'اسم الشيت ws.Cells(r, "b") = Sheets(i).Name ' اسماء الشيتات تسجل فى هذا العمود ws.Cells(r, "c") = Sheets(i).Range("c8") ' رقم العقد و الموجود فى هذه الخلية من الشيتات المشار اليها ' عدد الصفوف بالشيت Z = Sheets(i).Cells(Rows.Count, "b").End(xlUp).Row ' آخر صف فى هذا العمود For i2 = 12 To Z ' البداية من الصف 12 حتى الصف 'التاريخ dt = Sheets(i).Cells(i2, "b") ' الاعمدة التى تحتوى على التواريخ التى سيتم جلب البيانات منها For i3 = 4 To 15 ' الاعمدة التى سوف يتم جلب البيانات اليها If Month(ws.Cells(6, i3)) = Month(dt) And Year(ws.Cells(6, i3)) = Year(dt) Then ' شرط استدعاء البيانات ws.Cells(r, i3) = Sheets(i).Cells(i2, "f") + ws.Cells(r, i3) ' الامر بأضافة البيانات End If Next i3 Next i2 r = r + 1 Next i End Sub

شكرا اخوي موسى 🙂 وهذا رابط أخر ، فيه شرح يخص الاستعلام : جعفر

وعليكم السلام أخي حامل المسك 🙂 جرب .. أكتب في المعيار : Like IIf(Len([Forms]![a123]![a1] & '')=0;"*";[Forms]![a123]![a1]) وراجع ( طرق التعامل مع الامر Like في الاستعلام ) مع مهندسنا العود @jjafferr 🙂

جرب الآن تقريب_03.xlsx

السلام عليكم 🙂 اخي ابو احمد @AbuuAhmed اسمح لي اكون اول من يُهنّيك على الترقية 🙂 هي مجرد القاب للمحترفين ، وتعريف الباقين بكم 🙂 جعفر

السلام عليكم ,,,بعد تقديم كل الشكر والتحية لاعضاء الجروب المحترمين اقدم لكم ملف لعمل عروض الاسعار والفواتير ..الملف يعتبر تجميع موضوعات مختلفة في ملف واحد مميزات الملف ..الترحيل ...البحث ..التعديل حفظ نسخة من الملف Pdf .. الي الاميل Pdf ارسال ملف ال ارسال رينج معين كا صورة الي برنامج واتس اب الملف يعمل علي اوفيس 64 .. * InternetExplorer* يعتمد علي برنامج واتس اب ديسك توب او برنامج عرض سعر .xlsm

Sub Convert_Formula_To_VBA() Dim ws As Worksheet, lr As Long Set ws = ThisWorkbook.Worksheets("Sheet1") Application.ScreenUpdating = False With ws lr = .Cells(Rows.Count, 2).End(xlUp).Row With .Range("C2:C" & lr) .Formula = "=COUNTA(A2,B2)" .Value = .Value End With End With Call Convert_Formula_To_VBA2 Application.ScreenUpdating = True End Sub كما يمكنك وضع الكود بهذه الطريقة Sub Convert_Formula_To_VBA3() Dim ws As Worksheet, lr As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") With ws lr = .Cells(Rows.Count, 2).End(xlUp).Row With .Range("C2:C" & lr) .Formula = "=COUNTA(A2,B2)" .Value = .Value End With With ws With .Range("D2:D" & lr) .Formula = "=COUNTA(A2,B2,C2)" .Value = .Value End With End With End With Application.ScreenUpdating = True End Sub

تفضل اخي Sub MH_copy() Dim i As Long Application.ScreenUpdating = False With Cells(1).CurrentRegion For i = 2 To .Rows.Count Step 6 lastro = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row + 1 .Rows(i).Resize(6).Copy Range("c" & Rows.Count).End(xlUp)(2).PasteSpecial Transpose:=True Next End With If Range("c3").Value <> "" Then Range("C2:h" & lastro).Select With Range("C2:h" & lastro).Borders.LineStyle = xlNone Range("C2:h" & lastro).Borders.LineStyle = xlContinuous Range("a1").Select Application.ScreenUpdating = True End With End Sub 1.xlsm

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

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

وعليكم السلام ..هل هذا ما تقصده ؟! ولكن كل هذا بمقابل مادى وليس ببلاش !! https://superuser.com/questions/351494/show-excel-sheet-tab-in-≥-2-rows

كان عليك استخدام خاصية البحث بالمنتدى قبل طرح مشاركتك فبه طلبك -تفضل https://www.officena.net/ib/search/?&q=تفقيط مساحة&search_and_or=and&sortby=relevancy

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

الظاهر حظي فوق النخل اليوم 🙂 ابو عبدالله جاب اسمي مرتين ("هارد لك" اخوي موسى ، مع اننا نعرف انك المقصود بالاسم الاول 🙂 ) جعفر

وعليكم السلام ورحمة الله وبركاته 🙂 اخوي موسى اعطاك سمكة ، واليك طريقة اصطياد السمكة بطريقة سهلة 🙂 جعفر

وعليكم السلام ورحمة الله وبركاته أخي أبو عبدالله 🙂 الرابط التالي ليس شرح لكيفية كتابة الدالة ، وإنما هي أداة تقوم بكتابتها نيابة عنك بمختلف أشكالها ووضعياتها .. ويمكنك من خلال الاطلاع على النتيجة تعلم الصياغة السليمة للدالة .. 🙂 💡⭐✨ --- الكاتب الآلي الذكي لدوال المجال Dloockup وأخواتها 😊 --- ✨⭐💡 تحياتي 🙂

الف الف مبروك ومن تقدم الى تقدم

وعليكم السلام..تفضل على الرغم انك لم تقم برفع ملف تصورى لما تريد مع وضع شكل النتائج المرجوة ,, حتى تتمكن الأساتذة من مساعدتك

فاجأتوني ، شكرا لكم على الثقة والترقية ، وشكرا لكم جميعا على التهنئة ، وإن شاء الله أكون عند حسن ظنكم دائما.

السلام عليكم ورحمة الله تعالى وبركاته اولا اسف على التاخير لم استطيع امس تعديل المعادلات بسبب ضيق الوقت وعدم توضيحك المسبق لامكانية زيادة اوراق العمل تفضل اخي تم وضع المعادلات لغاية 350 صف قابل للزيادة مع التعرف تلقائيا على اوراق العمل المضافة اما في حالة كانت عندك رغبة بالبحث فقط بالقيمة الموجودة في الخانة B4 يمكنك استبدال الكود الموجود في حدث ورقة toutal بهدا الكود رغم اني ارى ان المعادلات افضل بسبب انها تتيح لك رؤية جميع النتائج الموجودة في اوراق العمل كلها في نفس الوقت Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet If Target.Address = "$B$4" Then Me.Cells(4, 3).Resize(, 12).ClearContents If Not IsEmpty(Target) Then Set ws = Worksheets(Target.Value) Select Case ws.Name Case "toutal": Case Else: With Me .Range("C4") = ws.Range("B11") .Range("D4") = ws.Range("B6") .Range("E4") = ws.Range("B8") .Range("F4") = ws.Range("M6") .Range("G4") = ws.Range("B12") .Range("H4") = ws.Range("B13") .Range("I4") = ws.Range("B17") .Range("J4") = ws.Range("K47") .Range("K4") = ws.Range("L47") .Range("L4") = ws.Range("M47") .Range("M4") = ws.Range("N47") .Range("N4") = ws.Range("C81") End With End Select End If End If End If If Target.Count > 1 Or Target.Row <= 2 Then Exit Sub If Target.Column = 2 And Target.Value <> "" And Not (sheetExists(Target.Value)) Then Call newsh(Target.Value) Sheets("toutal").Select End If End Sub mango_MH.xlsm

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه frm_Main ، وبه حقل الاسم fName ، وحقل التاريخ:من Date_From ، وحقل التاريخ:الى Date_To ، والحقول في الاستعلام ، حقل الاسم fName ، وحقل التاريخ DateX . 1. اذا اردنا البحث عن اسم كامل (وليس جزء من اسم) ، فيجب ان يكون المعيار في الاستعلام: [forms]![frm_Main]![fName] 2. واذا كان حقل الاسم فارغا في النموذج ، ونريد ان نرى جميع الاسماء ، فالمعيار يصبح: iif(len([forms]![frm_Main]![fName] & '')=0,[fName],[forms]![frm_Main]![fName]) والشرح للتأكد بأن الحقل فارغ في النموذج، بدل ان نكتب IsNull([forms]![frm_Main]![fName]) or [forms]![frm_Main]![fName]=0 فإننا نختصر هذين الشرطين بشرط واحد len([forms]![frm_Main]![fName] & '')=0 iif(كان الحقل فارغ في النموذج,[fName] اعطنا جميع بيانات الحقل,[forms]![frm_Main]![fName]واذا كان الحقل به قيمة فاستعمل هذه القيمة) . 3. اذا اردنا البحث عن جزء من الاسم Like IIf(Len([forms]![frm_Main]![fName] & '')=0,"*","*" & [forms]![frm_Main]![fName] & "*") والشرح IIf(Len([forms]![frm_Main]![fName] & '')=0 نعم Like "*" لا Like "*" & [forms]![frm_Main]![fName] & "*") . 4. اذا اردنا البحث بين تاريخين بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null او طريقة استاذنا واخونا العود ابو خليل Between nz([forms]![frm_main]![Date_From];"01/01/1900") And nz([forms]![frm_main]![Date_To];"01/01/2100") . جعفر