الحسامي

السلام عليكم بارك الله فيك اخي دغيدي ووجودك في اي موضوع شرف للموضوع بحق اخي ابو احمد انت انسان اكثر من رائع افكارك تحسد عليها ودوما نؤكد ان الفكرة الجيدة هي اساس نجاح اي حل --------------- ومن بعد اذنكم احببت المشاركة لاثراء الموضوع وتعدد الحلول مرفق ملف شئون عاملين1111.rar

السلام عليكم اخي ياسر هذا النوع من الدوال لست ملم فيه بدرجة كبيرة ولا استخدمه مطلقا وعلى اي حال هنا التعديل الذي تريده على نفس الدالة وتقوم بالتجميع وقد قمت بتعديلها لتناسب حاجتك لها Option Explicit Public Function MultVlookup( _ FindThis As Variant, _ LookIn As Range, _ SheetRange As String, _ OffsetColumn As Integer, _ Optional ReturnAddress As Boolean = False) _ As Variant Dim Sheet As Worksheet Dim strFirstSheet As String Dim strLastSheet As String Dim SheetArray() As String Dim blnFirstSheet As Boolean Dim rngFind As Range Dim blnFound As Boolean Dim intSheets As Integer Dim rngFind1 As String Dim n As Integer Dim Total_sum As Integer Dim sum As Integer Application.Volatile If LookIn.Columns.Count > 1 Then Set LookIn = LookIn.Resize(LookIn.Rows.Count, 1) End If ReDim SheetArray(ActiveWorkbook.Worksheets.Count) strFirstSheet = Left(SheetRange, InStr(1, SheetRange, ":") - 1) strLastSheet = Right(SheetRange, Len(SheetRange) - InStr(1, SheetRange, ":")) blnFirstSheet = False n = 0 For Each Sheet In ActiveWorkbook.Worksheets() If Sheet.Name = strFirstSheet Then blnFirstSheet = True End If If blnFirstSheet = True Then SheetArray(n) = Sheet.Name n = n + 1 End If If Sheet.Name = strLastSheet Then blnFirstSheet = False End If Next Sheet intSheets = n blnFound = False For n = 0 To intSheets - 1 Set rngFind = Worksheets(SheetArray(n)).Range(LookIn.Address).Find(FindThis, LookIn:=xlValues, _ MatchCase:=False, LookAt:=xlWhole) If Not rngFind Is Nothing Then blnFound = True Else blnFound = False End If If blnFound = True Then sum = rngFind.Offset(0, OffsetColumn - 1) Else sum = 0 End If Total_sum = sum + Total_sum Next n MultVlookup = Total_sum End Function استخدام اوسع للدالة VLOOKUP - هشام - الحسامي1.rar

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

السلام عليكم اخي الحبيب هشام شلبي بارك الله فيك على هذا المجهود والنشاط الرائع الذي تستحق عليه الثناء ------------------------------------- ولكن للفائدة هذه الدالة يوجد بها عيب وهو عدم تحديث البيانات عند تغييرها اي عندما نقوم بتغيير البيانات الرئيسية فلا تقوم هذه الدالة بايجاد البيانات الجديدة لعدم وجود الية لتحديث البيانات في داخل الكود وهذه الدالة بالاساس كانت المسودة الاولى والتجريبية لهذه الدالة وقد قام مبرمج هذه الدالة بصنع نسخة معدلة لهذه الدالة قام بتلافي الاخطاء الموجودة فيها حيث قام باستخدام امر تحديث البيانات لتحديث البيانات تلقائياً باستخدام الامر Application.Volatile كذلك قام باستحداث متغير جديد لوضع عدد الصفحات بداخله وهو المتغير "intSheets" بالاضافة الى بعض التعديلات البسيطة في الملف على اي حال هنا الدالة بنسختها الجديدة والمحدثة الخالية من العيوب والله من وراء القصد ولكن للفائدة احببت كتابة هذه المشاركة =multvlookup(A2,$A$2:$B$1000,"MyS1:MyS5",2,FALSE) Public Function MultVlookup( _ FindThis As Variant, _ LookIn As Range, _ SheetRange As String, _ OffsetColumn As Integer, _ Optional ReturnAddress As Boolean = False) _ As Variant Dim Sheet As Worksheet Dim strFirstSheet As String Dim strLastSheet As String Dim SheetArray() As String Dim blnFirstSheet As Boolean Dim rngFind As Range Dim blnFound As Boolean Dim intSheets As Integer Dim n As Integer Application.Volatile If LookIn.Columns.Count > 1 Then Set LookIn = LookIn.Resize(LookIn.Rows.Count, 1) End If ReDim SheetArray(ActiveWorkbook.Worksheets.Count) strFirstSheet = Left(SheetRange, InStr(1, SheetRange, ":") - 1) strLastSheet = Right(SheetRange, _ Len(SheetRange) - InStr(1, SheetRange, ":")) blnFirstSheet = False n = 0 For Each Sheet In ActiveWorkbook.Worksheets() If Sheet.Name = strFirstSheet Then blnFirstSheet = True End If If blnFirstSheet = True Then SheetArray(n) = Sheet.Name n = n + 1 End If If Sheet.Name = strLastSheet Then blnFirstSheet = False End If Next Sheet intSheets = n blnFound = False For n = 0 To intSheets - 1 With Worksheets(SheetArray(n)).Range(LookIn.Address) Set rngFind = .Find(FindThis, LookIn:=xlValues, _ MatchCase:=False, LookAt:=xlWhole) End With If Not rngFind Is Nothing Then blnFound = True End If If blnFound = True Then Exit For Next n If blnFound = True Then If ReturnAddress = False Then MultVlookup = rngFind.Offset(0, OffsetColumn - 1) Else MultVlookup = SheetArray(n) & "!" & _ rngFind.Offset(0, OffsetColumn - 1).Address End If Else MultVlookup = CVErr(xlErrNA) End If End Function المساعدة.rar

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

السلام عليكم اخي الكريم وكما قال اخي ابو احمد كان الاجدى منك ارسال ملف توضيحي لما تريده وتركنا نعمل باجتهادات قد تكون خاطئة او صائبة وللامانة لم افهم ما تريده بالصورة الكاملة . على اي حال هنا مرفق ملف توضيحي ويحتوي على عدة "TextBox" وبدون اي زر في البرنامج وتستطيع من خلاله استخدام ثلاثة مفاتيح مختلفة وهي مفتاح "F4" لترحيل البيانات و مفتاح "Delete" لمسح البيانات ومفتاح "Esc" للخروج من الفروم اما مبدأ عمل البرنامج فهو كالتالي : اولا يجب ان لايحتوي الفورم على " CommandButton "وان كان يحتوي فلن تعمل المفاتيح إلا عند تنشيط الادوات الاخرى من "TextBox" او "ComboBox" او "ListBox" ... الخ الفورم يحتوى على ثلاثة مايكروهات واحد لترحيل البيانات واسميناه "trans_data" وأخر لمسح البيانات واسميناه "delet_form" والاخير للخروج من الفورم واسميناه "exit_form" ومن ثم نقوم باستخدام حدث "KeyDown" للادوات او الحدث "KeyUp" لربط الماكروهات الثلاثة السابقة بالمفاتيح المحددة كالتالي : If KeyCode = 46 Then delet_form If KeyCode = 27 Then exit_form If KeyCode = 115 Then trans_data وهنا تم استخدام رموز المفاتيح للتعريف بها حيث يرمز المفتاح "Delete" بالرقم"46" والمفتاح "Esc" بالرقم27 والمفتاح "F4" بالرقم115 ويقوم مبدأ الكود على اساس عند الضغط على اي مفتاح من اللوحة وتم التعرف اليه يقوم بتنفيذ الكود المرافق له وكل مفتاح من مفاتيح لوحة المفاتيح له رقمه الخاص ويجب ان يوضع الكود السابق في جميع احداث الادوات المستخدمة في الفورم لكي يتم التعرف على المفاتيح وتنفيذ الكود المرافق له

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

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

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

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

السلام عليكم تفضل اخي المرفق invoice aah222.rar

يسلموا هالايادي اخي ابو احمد على الملف

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

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

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

السلام عليكم بارك الله فيك ويسلموا الايادي اخي ياسر

السلام عليكم اخي هشام واخي ابو احمد الرائعان بحق ما شاء الله وومكن ايضا اضافة التعريف Text بدلاً من التعريف Value List(R, 2) = Format(MyRange_Search.Cells(Mycel.Row - 1, 3).Text ويمكن استخدام التكرار في الكود لوجود حالات تكرارية في الكود For i = 0 To 5 List(R, i) = MyRange_Search.Cells(Mycel.Row - 1, i + 1).Text Next

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

اخي محارب الصحراء "مصطفى كمال " بارك الله فيك وشرف لي مرورك الكريم تحياتي وامتناني

اخي اخى dangerman2 هذا الكتاب من المراجع القوية للاكسل وترجمته للعربية سيستفيد منه الكثيرون بارك الله فيك

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

السلام عليكم تفضل اخي المرفق ويمكنك التعديل في مكان التفقيط invoice aah.rar

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

السلام عليكم اخي الكريم هنا مرفق لفورم لجلب البيانات المطلوبة عاملين.rar

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