عبدالله باقشير

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

السلام عليكم شاهد المرفق 2010 البحث بين تاريخين.rar

استاذنا ومعملنا استاذ عبدالله باقشير إستكمالاً لما تفضلتم به من تعقيب بحسبة بسيطة لو افترضنا متوسط فواتير البيع اليومي فقط 10 فواتير في اليوم في متوسط عدد سطور 20 سطر فيكون لدينا في نهاية العام المالي مايقرب من 72000 سطر داخل قاعدة بيانات البيع فقط دون باقي مستندات الدورة المستندية ونامل من الله عز وجل ان يكون لدى اخونا الكريم عمرو وفقه الله وجزاه خيرا مايبتعد به عن المعادلات داخل الخلايا ليتفادى بطء البرنامج تقبلوا تحياتي احسنت اخي هاني هذا ما قصدته بالفعل تقبل تحياتي وشكري

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

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

السلام عليكم استبدل كود زر تعديل بهذا لنفرض ان خلية التعديل B5 Private Sub ButtonDateChg_Click() [B5] = DateSerial(Me.SpinYear.Value, Me.SpinMonth.Value, Me.SpinDay.Value) End Sub في امان الله

السلام عليكم فورم بسيط لاضافة التاريخ بميزة احتساب الايام الفعلية للشهر المحدد المرفق 2003 فورم بسيط لادخال تاريخ.rar

السلام عليكم اخي عمر ابوصهيب مجهود كبير تشكر عليه جزاك الله خيرا تقبل تحياتي وشكري

السلام عليكم الشكر واصل لاخي الحبيب عبدالله واتمنى ان يكون هذا آخر طلب انا عدلت في المعادلة بداخل الشيت في الخلية J3 =ADDRESS(VLOOKUP(D3;N2:O5;2;0);((MATCH(C3;R2:R4;0)-1)*12)+B3+2) مع تعديل بسيط للكود Sub kh_Start() Dim Cel As Range Dim Adr As String Dim r As Integer, rr As Integer Adr = [J3] For Each Cel In Range("C6:C12") rr = Val(Cel) If rr Then With ورقة2.Range(Adr).Cells(rr, 1) .Value = Cel.Offset(0, 2).Value End With End If Next MsgBox "تم الترحيل بنجاح" End Sub في امان الله كود زر ترحيل111.rar

السلام عليكم جزاك الله خيرا بالنسبة للطلب: هذا الكود: Sub kh_Start() Dim Cel As Range Dim Adr As String Dim r As Integer, rr As Integer Adr = [J3] For Each Cel In Range("C6:C12") rr = Val(Cel) If rr Then With ورقة2.Range(Adr).Cells(rr, Columns.Count).End(xlToLeft) .Offset(0, 1).Value = Cel.Offset(0, 2).Value End With End If Next MsgBox "تم الترحيل بنجاح" End Sub المرفق 2003 كود زر ترحيل1.rar

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

تفضل المرفق 2003 كود زر ترحيل.rar

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

السلام عليكم استخدم الكود التالي: Sub kh_Start() Dim Cel As Range Dim r As Integer, rr As Integer For Each Cel In Range("C6:C12") rr = Val(Cel) If rr Then With ورقة2.Range("A2").Cells(rr, Columns.Count).End(xlToLeft) .Offset(0, 1).Value = Cel.Offset(0, 2).Value End With End If Next End Sub في امان الله

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

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

السلام عليكم في الملف حلين بزر وبالتغيير التلقائي في النطاق "C3:G8" هذا عند التغيير في النطاق Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("C3:G8")) Is Nothing Then If IsEmpty(Target) Then Target.ClearFormats Else kh_Formats Target End If End If End Sub واذا اردته بزر هذا الكود يرتبط بالزر ' هذا الكود بربوط بالزر Sub kh_SetRng() Dim Rng As Range, cel As Range Range("C3:G8").ClearFormats For Each cel In Range("C3:G8") If Not IsEmpty(cel) Then If Rng Is Nothing Then Set Rng = cel Else Set Rng = Union(Rng, cel) End If Next kh_Formats Rng Set Rng = Nothing End Sub وهذا الكود ذو الوسيط بستخدم من الكودين لتغيير الفورمات Sub kh_Formats(RngFormat As Range) If Not RngFormat Is Nothing Then With RngFormat .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Name = "Agency FB" .Font.Size = 16 .Borders.LineStyle = xlContinuous End With End If End Sub شاهد المرفق 2010 border.rar

السلام عليكم حسب فهمي للطلب تفضل المرفق 2003 223322.rar

السلام عليكم ضع المعادلة هذه في الخلية L2 =LOOKUP(2;1/((Table1[اسم العمبل]=$K$2)*(Table1[الدائن]<>0));Table1[الدائن]) ضع المعادلة هذه في الخلية M2 =LOOKUP(2;1/((Table1[اسم العمبل]=$K$2)*(Table1[الدائن]<>0));Table1[التاريخ]) شاهد المرفق 2010 دالة بحث1.rar هذه المعادلة تقريبا لاخي الخالدي او يحي حسين في امان الله

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

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

السلام عليكم شاهد المرفق 2003 فورم معلومات.rar

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

جزاك الله خيرا

السلام عليكم نورت المنتدى اخي يحي تقبل تحياتي وشكري