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

السلام عليكم ورحمة الله وبركاته إخواني الكرام في موضوع للأخ الحبيب محمد حسن أبو يوسف ، قمت بعمل تصفية للبيانات بناءً على مربع نص ، إلا أنه في مشاركة للأخ الغالي رشراش علي أن الكود لا بعمل مع الأرقام ولا يعطي نتيجة ، كما أن الأخ أحمد أبو زيزو طلب مني شرح خطوات العمل فيما يتعلق بهذا الموضوع رابط الموضوع وبناءً على طلب إخواني ، وهم يدركون أنني لا أتأخر عليهم أبداً أقدم لكم موضوع اليوم فارتأيت (حلوة ارتأيت دي ... ) أن أخصص موضوع لهذا الأمر ، نظراً للطلب عليه ، ونظراً للفائدة المرجوة منه ، حيث أنه يسهل عملية البحث من خلال تصفية البيانات المطلوبة. يعتمد الملف المرفق على مثال بسيط للتطبيق ، تم إدراج مربع نص TextBox من خلال التبويب Developer ثم من Insert اختر مربع نص TextBox من القسم ActiveX Controls والبيانات المراد التعامل معها تبدأ من الخلية C3 وحتى آخر خلية بها بيانات... إليكم إخواني الكود مع شرح مبسط للأسطر عله يفيدكم Private Sub TextBox1_Change() 'يقوم الكود بالبحث في نطاق من خلال مربع نص ، وتصفية النتائج طبقاً للنص المدخل '[Insert] ثم من قائمة [Developer] من خلال التبويب [TextBox] قم بإدراج مربع نص 'ثم قم بإدراجه على ورقة العمل [ActiveX Controls] قم بالنقر على مربع النص الموجود في '-------------------------------------------------------------------------- 'تعريف المتغيرات والثوابت Dim LastRow As Long, RngFiltered As Range, I As Long, Arr Static Rng As Range 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء الفلترة في ورقة العمل النشطة ActiveSheet.AutoFilterMode = False 'قيمة تظهر كل الصفوف لهذا النطاق [Static] إذا لم يكن للثابت المسمى If Not Rng Is Nothing Then Rng.EntireRow.Hidden = False 'تحديد آخر صف به بيانات في العمود الثالث LastRow = Range("C1000").End(xlUp).Row 'أي الخلية التي تسبق أول البيانات [C2] تعيين قيمة النطاق بداية من الخلية Set Rng = Range("C2:C" & LastRow) 'تعيين قيمة للمتغير من النوع مصفوفة ليساوي كل قيم النطاق Arr = Rng.Value 'إذا كان طول السلسلة النصية في مربع النص أكبر من صفر If Len(TextBox1.Text) > Then 'حلقة تكرارية لصفوف النطاق For I = 1 To UBound(Arr, 1) '[']إذا كان العنصر داخل المصفوفة رقمي يتم وضع علامة If IsNumeric(Arr(I, 1)) Then Arr(I, 1) = "'" & Arr(I, 1) Next I 'قيم النطاق تساوي القيم الجديدة في المصفوفة Rng.Value = Arr 'تصفية النطاق بشرط النص المدخل في مربع النص Rng.AutoFilter Field:=1, Criteria1:="=" & TextBox1.Text & "*" End If 'تعيين المتغير ليساوي الخلايا الظاهرة في النطاق Set RngFiltered = Rng.SpecialCells(xlCellTypeVisible) 'إلغاء الفلترة في ورقة العمل النشطة ActiveSheet.AutoFilterMode = False 'حلقة تكرارية لإعادة الأرقام للحالة الأولى بدون العلامة البادئة For I = 1 To UBound(Arr, 1) If Left(Arr(I, 1), 1) = "'" Then Arr(I, 1) = Mid(Arr(I, 1), 2) End If Next I Rng.Value = Arr 'إخفاء الصفوف للنطاق Rng.EntireRow.Hidden = True 'إظهار الصفوف للنطاق الذي تمت عملية التصفية على أساسه RngFiltered.EntireRow.Hidden = False 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub أترككم مع الملف المرفق .. قوموا بتجربة الملف .. تم إدراج بيانات مختلفة نصوص باللغة العربية وباللغة الإنجليزية وأرقام ... حمل الملف من هنا تقبلوا تحياتي أخوكم ياسر خليل أبو البراء

دالة الجمع الشرطى من صفحات متعدده السلام عليكم ورحمة الله وبركاته قد تقوم بعمل ملف للرواتب او للعملاء وتقسيمه على 12 شهر مثلا بعدد شهور السنه . وتحتاج الى جمع راتب موظف ما او عميل ما فى ال 12 شهر فهل ستقوم بعمل 12 معادله SUMIF من المعروف ان دالة الجمع الشرطى تقوم بالجمع بالشرط الذى تحدده انت فى ورقة العمل .. ولكن ماذا لو انك تريد جمع شرطى فى صفحات متعدده .سيكون الامر مجهد نوع ما لانك ستضطر الى الجمع فى كل الصفحات.ولكننا سنقوم بالجمع الشرطى من صفحات متعدده .وبمعادله واحده فقط ان شاء الله الدوال المستخدمه : SUMIF. INDIRECT .IFERROR الجمع الشرطى من صفحات متعدده.rar

السلام عليكم ورحمة الله أخي الكريم، في المعادلة الصحيحة التي اقترحها أخي الكريم أبو البراء سيظهر مشكل في القائمة المنسدلة وهي الفراغات في أسفل هذه القائمة في حالة تكرار الأسماء في القائمة الأصلية... لذا وهو مجرد اقتراح أن تُستبدل معادلة القائمة المنسدلة بالمعادلة التالية في كلتا النسختين: * المعادلة بالإنجليزية : =OFFSET($K$2;;;COUNTIF($J:$J;">=0")) * المعادلة بالفرنسية : =DECALER($K$2;;;NB.SI($J:$J;">=0")) وتطبيقها تجده في الملف المرفق بنسختيه.... أخوك بن علية الملف المرفق : Liste validation triée sans vides ni doublons.rar

وهذا حل ثالث بدالة معرفة أيضاً Function MySplitFunction(myStr As String, ref As Long) '=IFERROR(MySplitFunction($A1,COLUMN(A1)),"") MySplitFunction = Split(Application.Trim(myStr), ",")(ref - 1) End Function ويا ريت بالحلول المقدمة يكون الموضوع انتهى ومكونش قصرت معاااااااااااااك وبكدا يكون الأخ صلاح قدم لك حل بالمعادلات ، والعبد لله قدم لك حل بالكود ، وحلين بالدوال المعرفة ..(نقي واختار .. وسلم لي على مختار) Split Data UDF Function YasserKhalil V2.rar

عموماً يا مستر صلاح مش هسيبك تطلع الطلعة دي لوحدك بناءً على ملفك وليس ملف الأخ أبو سليمان ..إليك الكود التالي .. Sub SplitData() Dim I As Long, J As Long, SP Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For I = 5 To Cells(Rows.Count, 2).End(xlUp).Row SP = Split(Cells(I, "B"), ",") For J = LBound(SP) To UBound(SP) Cells(I, J + 3) = SP(J) Next J Next I Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub تقبلوا تحياتي وأستودعكم الله Split Data YasserKhalil.rar

للمره الثانية اقسم بالله انننني لم اقصد ارفاق الملف الاتصالات الادارية.rar

السلام عليكم ورحمه الله وبركاته بسم الله الرحمن الرحيم وبه نستعين على كل شىء وقبل كل شىء اللهم صلى على سيدنا محمد صلى الله عليه وسلم الحمد لله الذى تتم به الصالحات ,,,, برنامج تحليل المصروفات ( اداريه - بيع وتوزيع - تشغيل ) صدقه جاريه على روح والدتى رحمها الله وهديه للمنتدى !! اليوم اقدم لكم برنامج تحليل المصروفات الذى يغى كل محاسب وخاصه من الجيل القديم عن الدفتر الـ 70000 خانه هههههههههههه الـ 36 خانه عمل ممل ان تكتب بالدفتر فكان من وجه نظرى هذا العمل واعلم انه لم يعد يعمل احد بالدفاتر منذ فتره فقد انقرضت مع ظهور الانظمه المحاسبيه التى لا حصر لها واسألكم الفاتحه لوالدتى وولدى رحمهما الله اللذان ستظل روحى معلقه بهما دائما حتى يلحقنى بهما الله فى الجنه وجميع اخواننا المسلمين وانتظر ارائكم واستفساراتكم تلميذكم واخيكم // محمود الاسيوطى ( ابو اياد ) برنامج تحليل المصروفات اوفيسنا.XLSB

أتمنى من الله أن تكونوا جميعا بالف خير حبيت أطرح موضوع أكيد ليس بالجديد ولكنه مفيد أحيانا أتمنى الإفادة للجميع الموضوع هو عن فك حماية أوراق العمل Worksheets في أي مستند فالمرفق يحتوي على إضافة يمكن إضافتها للإكسل لتكون ثابته في كل ملفات الإكسل ما عليك إلا أن تفتح الملف الذي به الأوراق محمية وتضغط على الزر الذي سيتم تعيينه في الـ Ribbon وسيتم فك التشفير في لحظات http://forum.tawwat.com/images-topics/images/fa/0042.gif أولا : الكود المستخدم Public Sub ExcelPasswordRemover() Dim Mess As String, Header As String Dim Credit As String Dim RepBack As String, AllClear As String Dim PWord1 As String Dim ShTag As Boolean, WinTag As Boolean Dim w1 As Worksheet, w2 As Worksheet Dim i As Integer, j As Integer, k As Integer, l As Integer Dim m As Integer, n As Integer, i1 As Integer, i2 As Integer Dim i3 As Integer, i4 As Integer, i5 As Integer, i6 As Integer Application.ScreenUpdating = False Header = "Ýß ÊÔÝíÑ ÕÝÍÇÊ ÇáÅßÓá" Credit = vbNewLine & vbNewLine & "ãäÊÏíÇÊ ÃæÝíÓäÇ ÇáÊÚáíãíÉ" RepBack = vbNewLine & vbNewLine & "www.officena.com" With ActiveWorkbook WinTag = .ProtectStructure Or .ProtectWindows End With ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag And Not WinTag Then Mess = vbNewLine & "áÇ íæÌÏ ßáãÉ ÓÑ ááÕÝÍÇÊ ÇáÍÇáíÉ" & vbNewLine & Credit MsgBox Mess, vbInformation, Header Exit Sub End If Mess = "ÓæÝ ÊÓÊÛÑÞ ÚãáíÉ Ýß ÇáÍãÇíÉ ËæÇäí ãÚÏæÏÉ" & _ vbNewLine & "OK ÅÖÛØ " & vbNewLine & "æÅäÊÙÑ ÍÊì íÊã Ýß ÇáÍãÇíÉ " & vbNewLine & _ Credit MsgBox Mess, vbInformation, Header If Not WinTag Then Mess = "" & _ "" & vbNewLine & _ "ÌÇÑí ÍÐÝ ÇáÍãÇíÉ " & _ Credit MsgBox Mess, vbInformation, Header Else On Error Resume Next Do For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 With ActiveWorkbook .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _ Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If .ProtectStructure = False And _ .ProtectWindows = False Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Mess = "You had a Worksheet Structure or " & vbNewLine & _ Credit MsgBox Mess, vbInformation, Header Exit Do End If End With Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If If WinTag And Not ShTag Then Mess = "Only structure / windows protected with " & vbNewLine & _ "the password that was just found." & vbNewLine & _ AllClear & Credit & RepBack MsgBox Mess, vbInformation, Header Exit Sub End If On Error Resume Next For Each w1 In Worksheets w1.Unprotect PWord1 Next w1 On Error GoTo 0 ShTag = False For Each w1 In Worksheets ShTag = ShTag Or w1.ProtectContents Next w1 If Not ShTag Then Mess = AllClear & Credit & RepBack MsgBox Mess, vbInformation, Header Exit Sub End If For Each w1 In Worksheets With w1 If .ProtectContents Then On Error Resume Next Do For i = 65 To 66: For j = 65 To 66: For k = 65 To 66 For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66 For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66 For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126 .Unprotect Chr(i) & Chr(j) & Chr(k) & _ Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) If Not .ProtectContents Then PWord1 = Chr(i) & Chr(j) & Chr(k) & Chr(l) & _ Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _ Chr(i4) & Chr(i5) & Chr(i6) & Chr(n) Mess = "Êã ÍÐÝ ßáãÉ ÇáÓÑ " & _ Credit MsgBox Mess, vbInformation, Header For Each w2 In Worksheets w2.Unprotect PWord1 Next w2 Exit Do End If Next: Next: Next: Next: Next: Next Next: Next: Next: Next: Next: Next Loop Until True On Error GoTo 0 End If End With Next w1 Mess = AllClear & Credit & RepBack MsgBox Mess, vbInformation, Header End Sub يمكن استخدامه كماكرو عادي أو يمكن استخدامه كإضافة للإكسل لتكون ثابته في كل الملفات Addin طريقة إضافة الـ Addins للإكسل كالتالي بعد فتح أي ملف إكسل ومن علامة الإكسل في أقصى اليسار نضغط عليها ثم نضغط Excel Options ثم من القائمة نضغط على Addin ثم نضغط Go ونختار الإضافة من المكان الذي تم حفظها فيه ثانيا إظهار الإضافة في الـ Ribbon وأخير قم بفتح أي ملف به صفحات محمية بباسورد وأضغط على الإضافة كما موضحه في الصورة التالية وسيتم فك الحماية بمشية الله Sheet Password Remover AddIn.rar

السلام عليكم ورحمة الله وبركاته أثناء تجوالى في الانترنت وقعت على كتاب أكثر من رائع وبالعربي يشرح Excel VBA بأسلوب سهل جداً وبسيط وجذاب في أربعمائة صفحة، وأرجو أن ينال إعجابكم هاهو الرابط http://www.mediafire.com/download/dj01xxwnczia62k/VBA+Excel.rar دمتم بخير وود

السلام عليكم الاخ رجب . مرفق ملف الاكسل المعدل ويشمل على الحل للأتى 1- اضافة فاصل صففة للطباعة كل 20 اسم 2- نقل بيانات الفصل المحدد الى ورقة العمل 2 ثم ترتيبها حسب الديانة ثم حسب الاسم 3- نقل البيانات المطلوبة الى ورقة العمل 3 Class_Lists.rar

أخي وين المرفق

الله يسعد ايامك.. كلامك مضبوط وانما كان قصدي زيادة في المعلومة.. مايجي منك الا كل خير ياوجه الخير...

اخى الكرم ادرج مرفقك وانتظر اتك الفرج ان شاء الله

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

عذرا / ياسر لم ارى مشاركتك النت عندى بعافية شوية و لو ان معادلتك طبعا افضل و اسرع

أستاذي ياسر خليل أبو البراء ألف ألف شكر و جزاكم الله خير - والله ظللت أسبوع أبحث عن الحل بعلمي القليل جدا بالبرمجة - ولكن والحمد لله كرمني بمثلك ليعطيني الحل متابعك ومتابع فيديوهاتك وخفة ظلك - وتوصيل المعلومة بسهولة -- وكم يسعدني أن ترد على سؤالي ، ولو لم يكون به الاجابة - والحمد لله كان فيه الرد الكافي والشافي - وكم تعلم أن هذه الاجابة ستوفر على الكثيير فيالجهد والوقت ببرنامجي المتواضع لمدرستيشئون الطلبة ، فأنا شغوف للعلم وبشرط يكون في خدمة عملي - قولي أعملك إيه - على فكرة مش عندي أغلى من الدعاء لك ولأمثالك - بارك الله فيك وياريت تتعرف على أكثر من هذا الرابط http://www.thanwya.com/vb/forumdisplay.php?s=fcfd18b9dfe8bd04c6d4eed62cbeeceb&f=1036 فأنا المشرف وفي الختام اعذرني أطلت عليك ولكن ردك هو الذي جعلني أطيل والسلام عليكم ورحمة الله

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

أنا آسف ، فانت تتكلم عن حقلين ، بينما انا اتكلم عن حقل واحد هو التاريخ !! الحل سهل ، والامر هو: Private Sub Command1_Click() On Error GoTo Command1_Click_Err Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From TTTT Where [date]=#" & Me.iDate & "#") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount 'Output_Path= "c:\" Output_Path = Application.CurrentProject.Path & "\" For i = 1 To RC DoCmd.OutputTo acOutputReport, "AAAA", "PDFFormat(*.pdf)", Output_Path & rst!Cen, False, , 0, acExportQualityPrint rst.MoveNext Next i rst.Close: Set rst = Nothing Command1_Click_Exit: Exit Sub Command1_Click_Err: MsgBox Error$ Resume Command1_Click_Exit End Sub ولكن يجب ان اعرف تفاصيل أدق ، لذا رجاء ، اعمل لي/او ارفق سجلات صحيحة بتواريخ وارقام صحيحة ، كما ارفق لي سواء في اكسل ، او صورة ، توضح فيها السجلات التي تكون مجموعة مع بعض بالتاريخ و cen ، وعلى اساسه اضبط لك الكود ان شاء الله جعفر

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

شكرا لمرورك اخى الكريم الاستاذ احمد الرشيدى يمكنك استعماله على الاقل باوفيس 2007 نظرا لان الداله IFERROR غير موجوده على اصدار 2003 وانما موجوده فى 2007 فما فوق تقبل تحياتى

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

الأخ الحبيب والمعلم الكبير طارق اسمح لي أن أتقدم رغم أنه لا يحق لي التدخل بعد ردك ..إلا أنني كنت قد جهزت الكود ولكن عطلني أنني أردت شرحه للاستفادة منه الأخ الكريم المنار (ربنا يكفيك شر النار وشر الأشرار ويجعلك من المتقين الأبرار) :fff: إليك الملف التالي وإن شاء الله يفي بالغرض Sub SplitWB() 'يقوم الكود بفصل بيانات كل موظف في مصنف جديد مقسم إلى أوراق عمل جديدة '-------------------------------------------------------------------- 'تعريف المتغيرات Dim WB As Workbook Dim Arr Dim I As Long 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'تعيين قيمة للمتغير ليساوي كل القيم في النطاق الحالي في ورقة العمل 'المتغير يخزن البيانات على شكل مصفوفة Arr = ThisWorkbook.Sheets("Sheet1").Cells(1).CurrentRegion.Value 'حلقة تكرارية من الصف الثاني وحتى آخر صف به بيانات 'الحد الأعلى للبعد الأول للمصفوفة ألا وهو بعد الصفوف [UBound(Arr, 1)] حيث يمثل هذا الجزء For I = 2 To UBound(Arr, 1) 'ليساوي المصنف الجديد [WB] تعيين المتغير Set WB = Workbooks.Add 'بدء التعامل مع المصنف الجديد With WB 'إضافة ورقة عمل باسم "ملاحظات" ، ووضع البيانات المرتبطة من العمود التاسع بالمصفوفة With .Sheets.Add .Name = "ملاحظات" .Range("A1") = "ملاحظات" .Range("B1") = Arr(I, 9) .Columns.AutoFit End With 'إضافة ورقة عمل باسم "الأداء والمعلومات المالية" ، ووضع البيانات المرتبطة من العمود الرابع والسابع والثامن بالمصفوفة With .Sheets.Add .Name = "الأداء والمعلومات المالية" .Range("A1").Resize(3, 1) = Application.Transpose(Array("التقييم السنوي", "الراتب", "البدلات")) .Range("B1") = Arr(I, 4) .Range("B2") = Arr(I, 7) .Range("B3") = Arr(I, 8) .Columns.AutoFit End With 'إضافة ورقة عمل باسم "المعلومات الأساسية" ، ووضع البيانات المرتبطة من العمود الأول والثاني والثالث والخامس بالمصفوفة With .Sheets.Add .Name = "المعلومات الأساسية" .Range("A1").Resize(5, 1) = Application.Transpose(Array("اسم الموظف", "تاريخ التعيين", "الجنسية", "الوحدة", "الشعبة")) .Range("B1") = Arr(I, 1) .Range("B2") = Arr(I, 2) .Range("B3") = Arr(I, 3) .Range("B4") = Arr(I, 5) .Range("B5") = Arr(I, 6) .Columns.AutoFit End With 'وهي ورقة عمل افتراضية في أي مصنف جديد [Sheet1] حذف ورقة العمل المسماة .Sheets("Sheet1").Delete 'حفظ المصنف الجديد في نفس مسار المصنف الحالي باسم البيان الموجود في العمود الأول بالمصفوفة .SaveAs ThisWorkbook.Path & "\" & Arr(I, 1) & ".xlsx" 'إغلاق المصنف الجديد الذي تم حفظه .Close End With 'الانتقال لصف جديد والتعامل مع مصنف جديد Next I 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True 'رسالة تفيد بانتهاء عمل الكود MsgBox "Done !", vbInformation End Sub وفي انتظار مساهمتك يا باشمهندس .. زيادة الخير خيرين .. تقبلوا تحياتي :fff: Split Data Into Mulptiple Workbooks YasserKhalil.rar

اخى الكريم تم تعديل العلاقة بين الجدولين لتناسب الربط بين النموذ الفرعى ثانيتا نموذج ادخال موظف جديد ليس له فائدة فيمكنك ادخال الموظف من النموذج name_ وسيقوم البرنامج بتوليد الكود تلقائى بعد تحديث الاسم الثلاثى سيظهر الكود تلقائ Copy of Copy of رواتب.rar

وهذا حل آخر بدالة معرفة Function GetElement(Text As Variant, N As Integer, Delimiter As String) As String 'تقوم الدالة المعرفة بفصل البيانات بناءً على فاصلة تحددها 'يمثل البارامتر الأول النص أو البيان المراد فصل بياناته 'يمثل البارامتر الثاني رقم البيان المراد فصله أي موقع البيان المراد فصله 'يمثل البارامتر الثالث نوع الفاصل بين الكلمات أو البيانات '=GetElement($B5,COLUMN(A1),",") '-------------------------------------------------------------------------------- Dim Txt, Str As String Dim Count, I As Integer Txt = Text If Delimiter = Chr(32) Then Txt = Application.Trim(Txt) If Right(Txt, 1) <> Delimiter Then Txt = Txt & Delimiter End If Count = 0 Str = "" For I = 1 To Len(Txt) If Mid(Txt, I, 1) = Delimiter Then Count = Count + 1 If Count = N Then GetElement = Str Exit Function Else Str = "" End If Else Str = Str & Mid(Txt, I, 1) End If Next I GetElement = "" End Function عشان متقولش إني حارمك من حاجة يا أبو سليمان Split Data UDF Function YasserKhalil.rar

غالى و الطلب رخيص يا ا/ احمد office 2003.rar

العمود a يا ابو اليسر العمود ضيق وسع العمود عنك انت الطالعة دى لعله يكون المطلوب فصل الأسماء التى تريدها برقم.rar

بارك الله فيك اخى الكريم

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

اللي انا فاهمه حأقوله First-Last هما لمعرفة اول حقل تم ادخال اول/آخر معلومة في الحقل ، فيمكننا ان نطلب First لحقل معين ، ولكن نعمل الفرز من الكبير للصغير ، فينقلب الترتيب!! هو ده اللي انا فهمته من الاكسس بس سؤال: يا راعي الغنم أفندي ، ايش دخل هالموضوع بالسؤال؟ الحين بتحصل كرت أحمر لخروجك عن الموضوع جعفر

نسخة تعمل على وورد 2010 http://quran-in-ms-word.software.informer.com/download/

Private Sub Document_Close() ThisDocument.Saved = True End Sub

أخي العزيز اتمنى أن تجد الحل المناسب بالمرفق Book.rar

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

الحل كما تفضل به الاستاذ مارد وبعد اذن الاستاذ مارد المشكله كانت تكمن فى جدول تسجيل الدورات حيث ان خصائص رقم الموظف كانت غير مفهرسة ولا تقبل التكرار ولكى تتم العلاقة بالشكل المطلوب يجب ان تكون الخصائص Yes (Duplicates OK) مفهرس ويقب التكرار

أخي الحبيب محمود الحل في المشاركة رقم 7 حل رائع وممتاز أنا شخصياً أحبذه حيث أنه سيقوم بالتخلص من الفراغات والتكرار معاً وبدون مشاكل ..كل ما يلزمك عمود مساعد فقط هذا مجرد رأي ولك حرية الاختيار

حساب المرتب الإجمالى اذا علم المرتب الصافى http://www.aliateck.com/downloads/salary_calc/index.php Free Salary Calculator Egypt 2014-2015 *beta version* Your comments are highly appreciated. Thanks

بعد اذن أخى الحبيب الشهابي ولاثراء الموضوع هذا حل آخر باستخدام المعادلة sumproduct test1.rar

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته اشكر الجميع واتمنى من الله ان تكون مشاركتي فعالة تخدم كل من له علاقة بالمجال بالطبع عزيزي ابوعبدالله اوافقك تماما على هذه الفكرة فلو علمت ان تكلفة مثل هذا البرنامج قد تصل الى مئات الالوف لما ترددت في اكماله. وارجو ان يوافقني الجميع على البدء في تنفيذه لنبدا على بركة الله خطوة بخطوة اولا : كتصور مبدئي لشكل البرنامج فكبداية يجب عمل ال Chart سواء اكان للاصناف او للحسابات المالية وبنفس فكرة برنامج القدير ابو عبدالله مشروع 2 سيتم تسجيل الشجرة ثانيا يجب ان تكون هناك نافذة لادخال ارصدة افتتاحية اصناف وحسابات مالية كمرة واحدة لاتتكرر ولكن يمكن التعديل فيها بكلمة مرور من المستوى المتقدم ثالثا يجب التعرف على الدورة المستندية(المستندات التي سيتم تسجيل بياناتها التي سيتم بناء البرنامج على اساسها رابعا يجب تحديد صلاحيات لكل مستخدم سوف اطرحها في وقتها خامسا معرفة مخرجات عملية تسجيل البيانات وساقوم برفع شكل التقارير المطلوبة بشكل يومي او بشكل شهري او سنوي ولتكن البداية مع المخزون والذي سبق وان اوضحت اركانه الرئيسية والمستندات الرئيسية المستخدمة ستكون (بدون توسيع نطاق المستندات) هي فواتير الشراء (سواء اكانت نقدية او آجلة )وفواتير الارجاع للمورد واذون استلام البضاعة و( سندات صرف البضاعةو سندات تحويل داخلي ) Debits To Cost و(شيكات البيع في كل Area او Outlet (وشيكات الاوفيسر وشيكات الضيافة ومستند اتلاف او اهلاك بضاعة) Credits to Cost الاخ الجليل ابو عبدالله الموضوع اعلم انه ليس بالسهل ولكن عندي الثقة الكاملة في قدرتك ان شاء الله على اكماله على احسن صورة بفضل خبرتك الواسعة في مجال البرمجة. وفيما يخص Recipe الاصناف ففكرته تقوم على تحديد مبدئي ولكن محسوب جيداً لمكونات صنف سيتم بيعه من خلال تصنيعه بمكونات مأخوذة من Chart الاصناف ثم اضافة نسبة تجهيز تتراوح بين 4 و 5 % من اجمالي تكلفة المكونات .وهذه النسبة متروكة لرؤية محاسب التكاليف فمثلا الصنف س يستمر على النار لمدة 10 دقائق وغيره قد تستمر لمدة 30 دقيقة وهكذا ..... وبناء عليه يمكن تحديد سعر بيع المنتج وتحديد نسبة التكلفة له ومفهوم التكلفة هنا يعني بالبلدي (احنا بندي الطباخ بضاعة 40 جنيه يبيعها ب 100 جنيه يبقى تكلفة المنتج 40 % ندخل في تفاصيل هامة : دورة المستندات ستكون بالشكل التالي فاتورة شراء يتم تسجيل بياناتها لتكون عندي تكلفة الاصناف المشتراة وباذن الاستلام سيكون لدي رصيد البضائع داخل المخازن ( 4) التي تم تحديدها وعند عمل سند صرف من المخازن يجب معرفة المكان الذي سيتم الصرف اليه وكذلك تكلفة الاذن بالكامل وهنا يجب الاشارة على ان غالبية الفنادق تعمل بنظام متوسط حركي للمخزون صنف مثل الطماطم دخل المخازن يوم 3 في الشهر 50 كيلو بسعر 4 جنيه للكيلو وفي يوم 6 دخل كمان 50 كيلو ولكن بسعر 5 جنيه للكيلو فلو تم صرف بضاعة يوم 5 فالسعر هيبقى 4 جنيه للكيلو اما اذا تم الصرف يوم سبعة فسيكون السعر 4.5 جنيه. وحتى لااطيل عليكم فساقوم برفع ملف قديم عندي كنت قد صممته من فترة بعيدة وهو يؤدي الغرض ولكن بعد ان نرى الردود والمساهمات وسامحوني جميعا فالوقت ليس معي بحكم وظيفتي التي تستهلك مني اكثر من 14 ساعة عمل ولكن ارجو ان تتقبلوا عذري ولتكن هناك مساهمات من الاخوة المهتمين بالموضوع هاني بدر

السلام عليكم الاخ الفاضل/ محمدي -------حفظه الله الاخ الفاضل/ سالم شباني -------حفظه الله ربنا يبارك فيكما تقبلا جزيل شكري وتقديري ================================= الاخ الفاضل/ ابو سارة -------حفظه الله استخدم الكود التالي: Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = Range("C17").Address Then Cancel = True form_Cm_Search.Show 0 End If End Sub