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

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

السلام عليكم ورحمة الله وبركاته الدرس الاول 2-RANGE هنا سوف نتعرف على كيفية الاشاره الى خليه او الى مجموعه من الخلايا وانا بعتبر ان الدرس ده هو اهم درس يجب البدأ بيه فى تعلم VBA لان مفيش تطبيق يتم فى VBA بدون الاشاره الى الخلايا تقبلوا تحياتى

أخي الكريم أبو عبد الملك يبدو أنك نسيت المبدأ .. بدلاً من أن تقوم بالرفع للموضوع أكثر من مرة كان يمكنك طرح موضوع جديد بطلبك الجديد في غيابي وأعتقد ساعتها يمكن أن تجد استجابة أعتقد - وهذا مجرد رأي شخصي - أن الموضوعات الجديدة تستقطب الأعضاء أكثر من الموضوعات التي بها رد مسبق لأن العضو الذي يريد المساعدة عندما يجد رد مسبق يظن أن الموضوع قد انتهى أو أنه لكي يقدم المساعدة فعليه أن يتابع الموضوع من البداية وفي هذه الحالة وقته قد لا يسمح فيعزف عن الموضوع ، أو يترك المجال لمن قام بالرد أولاً أن يقوم بالرد مرة أخرى بدون تدخل منه عموماً معلش صدعتك إليك الكود التالي عله يكون المطلوب Sub FollowAll() Dim I As Long, lRow As Long Dim rngFound As Range Dim wsRecord As Worksheet, wsMonthly As Worksheet, SH As Worksheet Set wsRecord = Sheets("معلومات التسجيل"): Set wsMonthly = Sheets("مجمع النتائج الشهرية"): Set SH = Sheets("كشف متابعة") With Application .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual End With With wsRecord For I = 2 To .Cells(Rows.Count, "A").End(xlUp).Row If Not IsEmpty(.Cells(I, "N")) Then If MsgBox("الطالب " & .Cells(I, "C") & " منقطع هل تود أن تطبع له كشف?", vbYesNo + vbMsgBoxRtlReading) = vbYes Then GoTo Continue Else: End If Else Continue: SH.Range("C1") = .Cells(I, "C") SH.Range("C4") = .Cells(I, "B") SH.Range("C5") = .Cells(I, "A") Set rngFound = wsMonthly.Columns("C:C").Find(What:=.Cells(I, "C"), searchorder:=xlByRows, searchdirection:=xlPrevious) If Not rngFound Is Nothing Then lRow = rngFound.Row If wsMonthly.Cells(lRow, "R") >= 60 Then SH.Range("R4") = wsMonthly.Cells(lRow, "N"): SH.Range("S4") = wsMonthly.Cells(lRow, "O") ElseIf wsMonthly.Cells(lRow, "R") < 60 Then SH.Range("R4") = wsMonthly.Cells(lRow, "L"): SH.Range("S4") = wsMonthly.Cells(lRow, "M") Else MsgBox "لا يوجد درجة للطالب " & .Cells(I, "C"), vbCritical End If End If SH.Range("C2").Formula = "=IF(" & SH.Range("R4").Address & "="""","""",LOOKUP(INDEX(QNumbers,MATCH(" & SH.Range("R4").Address & ",QNames,0)),الحلقات!$F$2:$F$6,الحلقات!$B$2:$B$6))" SH.Range("C3").Formula = "=IF(" & SH.Range("R4").Address & "="""","""",LOOKUP(INDEX(QNumbers,MATCH(" & SH.Range("R4").Address & ",QNames,0)),الحلقات!$F$2:$F$6,الحلقات!$D$2:$D$6))" SH.Range("C2:C3").Value = SH.Range("C2:C3").Value Call CalculateLinesOfRevision SH.PrintPreview End If Next I End With With Application .ScreenUpdating = True: .EnableEvents = True: .Calculation = xlAutomatic End With End Sub Private Sub CalculateLinesOfRevision() Dim SH As Worksheet, wsMnhg As Worksheet Dim LRCur As Long, I As Long, II As Long, N As Long, Counter As Long, P As Long Dim rngA As Range, rngB As Range, rngC As Range, rngD As Range Dim X, Y, Z Set SH = Sheets("كشف متابعة"): Set wsMnhg = Sheets("المنهج") With wsMnhg LRCur = .Cells(Rows.Count, 1).End(xlUp).Row Set rngA = .Range("A2:A" & LRCur): Set rngB = .Range("B2:B" & LRCur) Set rngC = .Range("C2:C" & LRCur): Set rngD = .Range("D2:D" & LRCur) SH.Range("Q11:Q34").ClearContents X = ValueLookUp(rngB, SH.Cells(4, "R").Value, rngC, rngD, SH.Cells(4, "S").Value, rngA) If X <= 24 Then For I = 2 To X + 1 SH.Cells(N + 11, "Q") = .Cells(I, "B") & " " & .Cells(I, "C") & " - " & .Cells(I, "B") & " " & .Cells(I, "D") N = N + 1 Next I Else Y = Application.WorksheetFunction.Ceiling(X / 24, 1) For I = 2 To X + 1 Step Y SH.Cells(N + 11, "Q") = .Cells(I, "B") & " " & .Cells(I, "C") & " - " & .Cells(I + Y - 1, "B") & " " & .Cells(I + Y - 1, "D") N = N + 1 Counter = Counter + Y If Y >= X - I Then Exit For Next I If X - Counter > 0 Then SH.Cells(N + 11, "Q") = .Cells(I + Y, "B") & " " & .Cells(I + Y, "C") & " - " & .Cells(X + 1, "B") & " " & .Cells(X + 1, "D") End If SH.Range("O11:O34").ClearContents Z = X - 24 If Z > 0 Then SH.Range("O11:O34") = .Cells(Z, "B") & " " & .Cells(Z, "D") & " - " & SH.Range("R4") & " " & SH.Range("S4") SH.Range("M11:M34,I11:I34").ClearContents P = 1 For II = 11 To 34 SH.Range("M" & II) = .Cells(X + P, "B") & " " & .Cells(X + P, "C") & " - " & .Cells(X + P, "D") SH.Range("I" & II) = .Cells(X + P + 1, "B") & " " & .Cells(X + P + 1, "C") & " - " & .Cells(X + P + 1, "D") P = P + 1 Next II SH.Range("M11:M34").Copy SH.Range("K11") End With End Sub

أخي الكريم ولد الحجاز الموضوع أبسط مما تتخيل هديك مثال وإنت كمل يا جميل تعالى في الخلية D3 في أول معادلة وعدل المعادلة بهذا الشكل =IF(B3="","",DATEDIF(B3,C3,"y")) أضفت لك جزء بقول فيه لو الخلية B3 كانت فاضية مش مشغولة بأي بيانات ، يا عم الإكسيل خلي الناتج فاضي وإلا كمل الجزء التاني ، فلما تكون الخلية فاضية هيكون الخلية اللي فيها الناتج فاضية كمل بنفس الأسلوب ملحوظة هامة : إذا لم تعمل المعادلة معك قم بتغيير الفاصلة العادية بفاصلة منقوطة (أصلي مغير في إعدادات الويندوز لأني برتاح في الفاصلة العادية أكثر من الفاصلة المنقوطة) تقبل تحياتي

أخي الحبيب حسام عيسى بارك الله فيك على الرابط الرائع والمفيد أخي الغالي جعفر لكم يسعدني ويدخل السرور على قلبي أن أرى مشاركاتك فيما بيننا أخي الكريم أشرف النعاس افتح الملف انقر بالماوس على زر الأمر Test1 .. هيطلع لك عفريت (متخافش منه دا عفريت صاحبي وأنا عارفه) هتلاقي في العفريت زر أوك اضغط عليه وهتلاقي قدامك أسطر باللون الأحمر تعالى بعد كلمة Declare وأضف كلمة PtrSafe هتلاقي السطر اللي بالأحمر بقا بالأزرق اضغط F5 عشان تنفذ هيطلع لك العفريت تاني كرر نفس الخطوات .. أضف الكلمة PtrSafe بعد كلمة Declare إلى أن تنتهي من جميع الأسطر وتختفي الأسطر التي باللون الأحمر يا ريت بس متنسناش بدعوة .. تقبلوا تحياتي

الكود التالي يطلب من المستخدم ادخال الباسوورد "123" عند افتتاح الملف لأول مرة على الجهاز ..لو الباسورد غلط فالملف يغلق نفسه تلقائيا ... لو المستخدم عمل كوبي للملف و فتح الكوبي على جهاز أخر فالكود يشتغل من جديد و يتم طلب الباسوورد في المرة الأولى فقط طبعا لو الماكروس غير شغالة ( Macros Disabled ) عند المستخدم فان الكود لن يعمل لكي لا يستطيع المستخدم رؤية الباسورد ينصح حماية ال VBAProject أضف الكود التالي الى ThisWorkbook Module : Private Sub Workbook_Open() Dim bool As Boolean On Error Resume Next bool = [DriveSN] = GetDriveSerialNumber On Error GoTo 0 Application.EnableCancelKey = xlDisabled If bool = False Then If InputBox("Enter the Password") <> "123" Then MsgBox "Wrong Password ..." & vbCrLf & "Workbook Closing !", vbExclamation Application.EnableCancelKey = xlInterrupt Me.Close False Else Names.Add "DriveSN", GetDriveSerialNumber, False: Me.Save End If End If Application.EnableCancelKey = xlInterrupt End Sub Private Function GetDriveSerialNumber() As Long Dim oFso As Object Set oFso = CreateObject("Scripting.FileSystemObject") With oFso.GetDrive(oFso.GetDriveName(Application.Path)) GetDriveSerialNumber = Abs(.SerialNumber) End With Set oFso = Nothing End Function

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

السلام عليكم درس غاية في الروعة جزاكم الله خيراً تقبل تحياتي

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

الاخ الكريم راجع الرابط التالى للقدير/ هانى بدر ستجد ما تريد وزياده http://www.officena.net/ib/topic/60609-ليبل-ينبض-اثناء-تنفيذ-امر-الماكرو/ تقبل تحياتى

اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما اللهم اشفه انت الشافي لا شفاء الا شفائك , شفاء لا يغادر سقما

الحمد لله رب العالمين....زينت المنتدى....اللهم لك الفضل والمنة الحمد لله على السلامة....لا أدري ما أقول...فرحتي غامرة انتبه لنفسك .. فإن لبدنك عليك حقاً .. لا ترهق نفسك ((قل لن يصيبنا إلا ما كتب الله لنا هو مولانا وعلى الله فليتوكل المؤمنون)) والسلام عليكم.

أخويّ الكريمين حسام وعبد العزيز السلام عليكم ورحمة الله وبركاته أشكركما جزيلاً على إبدائكما إعجابكما بما أقول ...هذا من كرم أخلاقكما . لكنني يا أخويّ الكريمين بعد أن اطلعت على بعض أعمال أخينا الذي افتقدناه جسداً وبقية أعماله شاهدة على نبله وكرمه عماد الدين الحسامي أدعو الله أن يتغمده برحمته...تحسرت لأنني لم أكن أعرفه رأيت هندسة بارعة في التصميم ووقوفاً في صف المظلومين ..كأنه أدخل هندسة الديكور في قوالب تصميم(نظام الحسامي للمخازن) يا ليتني كنت في زمن مشاركاته ولو لفترة محدودة...كنت تشرفت بهذا العلم الذي طالته يد المنون ولا أقول إلا ما يرضي ربنا. لا حول ولا قوة إلا بالله العلي العظيم...إنا لله وإنا إليه راجعون ...والسلام عليكم.

السلام عليكم مرفق مثال باستخدام التنسيق الشرطى لمجموعة من 5 اعمدة وبيتلون الصف لما تكتب فى الخمسة كلهم بالكامل .. باستخدام التنسيق الشرطى Select Color When Completed .rar

حديث لرسول الله -صلى الله عليه وسلم-، يقول: عن أبي هريرة -رضي الله عنه- أن رسول الله -صلى الله عليه وسلم- قال: إذا مات ابن آدم انقطع عمله إلا من ثلاث: صدقة جارية، أو علم ينتفع به، أو ولد صالح يدعو له، رواه مسلم راحل عنا امس العلامه القدير الاستاذ عماد الدين الحسامى وترك لنا علم ينتفع به حبيب اذكركم ببعض ما ترك لنا من اعمال وعلم ينتفع به أسال الله تعالى ان تكون جميع اعماله فى ميزان حسناته ممكن حضرتك تدخل على مكتبه الاستاذ عماد ونشوف اعماله من صفحته الشخصيه بالمنتدى الحسامى.zip الحسامى 2.zip شرح الفورم.zip نظام الحسامي للمخازن.zip واجهه كنترول للاستاذ الحسامي.zip شجرة الحسابات-عماد الحسامي.zip

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

السلام عليكم ورحمة الله وبركاته. اقتراحات: 1 - إن استخدام بعض الزملاء الأعضاء الجدد لصور شخصية مشوهة كصور أفلام الكرتون المنفرة والمقززة تجعلنا نشيح بنظرنا عنها وكذلك الصور التي لها طابع سياسي أو عسكري غير مرغوبة رجاء متابعتها وطلب تغييرها. 2 - كان هناك شريط إعلان عن المشاركات الجديدة يظهر أعلى الصفحة افتقدناه. 3 - كان للمرفقات التي يحملها العضو الكريم في المشاركات يظهر عدد مرات تنزيلها فنتبين أهميته لكثرة تنزيله. 4 - لا يزال العديد ممن ينتسبون للمنتدى الكريم يدخلون بأسماء أجنبية أو معربة حرفيا" فمتى تنتهي هذه الظاهرة. تقبلوا تحياتي والسلام عليكم.

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

السلام عليكم ورحمة الله غدا" إن شاء الله تعالى الحمد لله أن استجبتم لطلبي وهذا كما يقال بلهجتكم المحببة....هذا عشمي بكم والسلام عليكم.

أبي الحبيب أبو يوسف أعتذر عن التأخر في الرد على الموضوع هو ايه الموضوع ..!! فين الرابط المطلوب تثبيته ؟؟ رغم أني لا أحب الموضوعات المثبتة .. حتى يمكنك أن تلاحظ أنني أزلت التثبيت من الموضوع الخاص بي (افتح الباب) ؛ حيث لاحظت أن الموضوعات المثبتة بدأت تشغل حيز كبير من الصفحة عموماً سأقوم بتثبيت الموضوع لفترة شهر .. لكي يقوم أكبر عدد من الأعضاء بالإطلاع عليه فقط ساعدني بوضع رابط الموضوع المراد تثبيته تقبل تحياتي

السلام عليكم..بردا وسلاما...متابعينكم...مواضيعكم ممتعة..الله يعافيكم.بدأنا مشوار الألف ميل بخطوة...

أخي الحبيب إبراهيم مشكور على المجهود الرائع ومتابعينك فخلي بالك متخليش الجهاز يتعطل تاني ..

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

السلام عليكم و رحمة الله و بركاته بالنسبة للملف يوجد ملف وضعته خطأ ..المهم اسم المستخدم : ولد الحجاز و كلمة المرور :123 أمّا كلمة المرور لمحرّر الأكواد هي :123123 أمّا الألوان في أزرار الأمر .. شغّل نفسك بهذا الملف ..و غيّر الألوان حسب هواك .. على فكرة هناك ملف لأكواد الألوان وضعته منذ قليل في موضوع " سلسلة علمني كيف أصطاد " لأستاذنا الغالي " الصقر " جزاه الله خيرًا .. زر أمر ملوّن.rar

ألقيت نظرة على الملف و وجدت أن ال ProgressBar وراء الزر TEST2 يشتغل على جميع اصدارات الويندوز لأنه يعتمد على ليبل كونترول عادي

السلام عليكم و رحمة الله و بركاته حاول مع هذا الملف أخي العزيز و لد الحجاز ربما يفي بالغرض خالص احتراماتي A2.rar A2.rar

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

حلك حل عملاق اخى واستاذى الصقر واقدم لكم حلى المتواضع بدون VBA has22.rar

السلام عليكم ممتاز استاذ الصفر

الاخ الحبيب جرب المرفق هل هو طلبك تم عمل زر واحد فقط للسريل والحدود ان شاء الله ينال اعجابك هذا هو الكود المستخدم Sub hossam() Columns("A:E").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone Selection.Borders(xlEdgeLeft).LineStyle = xlNone Selection.Borders(xlEdgeTop).LineStyle = xlNone Selection.Borders(xlEdgeBottom).LineStyle = xlNone Selection.Borders(xlEdgeRight).LineStyle = xlNone Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Dim Lr As Integer Lr = Cells(Rows.Count, "B").End(xlUp).Row With Sheets("وقة 2").Range("A3:a100000") .ClearContents End With [a2] = 1 hh = Application.WorksheetFunction.CountA(Sheets("ورقة 2").Range("b2:b100000")) If hh > 1 Then With Sheets("ورقة 2").Range("A3:a" & Lr) .Formula = "=sum(A2+1)" .Value = .Value End With End If Range("A1:E" & Lr).Select With Selection.Borders(xlEdgeLeft) .LineStyle = xlDashDotDot .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlMedium End With With Selection.Borders(xlEdgeTop) .LineStyle = xlDashDotDot .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlMedium End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlDashDotDot .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlMedium End With With Selection.Borders(xlEdgeRight) .LineStyle = xlDashDotDot .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlMedium End With With Selection.Borders(xlInsideVertical) .LineStyle = xlDash .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlThin End With With Selection.Borders(xlInsideHorizontal) .LineStyle = xlDash .ThemeColor = 4 .TintAndShade = 0.399945066682943 .Weight = xlThin End With End Sub اللهم اجعلنا ممن يقيم حدودك و لا تجعلنا ممن يضيعها تقبل تحياتى has.zip

شكرا يالصقر

السلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذنا الغالي محمد حسن المحمد على الملاحظة .. فعلاً لم أنتبه لهذا .. و أنّ العمل سيكون بلوحة المفاتيح و ذلك يتوجّب جزئية خاصة من الأكواد .. و الشيء الذي زاد من معاناتي هو إنقطاع النت عندي منذ البارحة ليلاً و لم أعِدْ مشاهدة الموضوع و ملاحظتك سوى منذ لحظات .. و قد جاء الفرج سيّدي محمد حسن المحمد لي و لك و لصاحب الملف من أستاذنا الغالي على قلوبنا KHMB .. بارك الله فيكما و زادها بميزان حسناتكما و زادكما من علمه و فضله

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

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

السلام عليكم أخي عبد العزيز ...قد جربت حذف زر التأكيد فلم يعمل ...يرجى الاطلاع

اخى الكريم جرب المرفق هل هو ما تريد تقبل تحياتى C1.zip

أخي الكريم عمرو حسني إليك الكود التالي Private iGblGoldenTotal As Long Private iGblOutputRow As Long Private iGblMatchingTotalCount As Long Private Const nOutputHeaderROW = 2 Sub FindCombinationsAddingToGoldenTotal() Dim vElements As Variant Dim vresult As Variant Dim I As Long, T As Long Dim iLastIndex As Integer Dim sValue As String Sheets("Sheet1").Range("H3:Z" & Rows.Count).ClearContents iLastIndex = 0 ReDim vElements(1 To 1) iGblGoldenTotal = Range("D1").Value For T = 2 To Cells(Rows.Count, "B").End(xlUp).Row sValue = Range("B" & T).Value If IsNumeric(sValue) Then iLastIndex = iLastIndex + 1 ReDim Preserve vElements(iLastIndex) vElements(iLastIndex) = sValue End If Next T iGblOutputRow = nOutputHeaderROW iGblMatchingTotalCount = 0 For I = 1 To UBound(vElements) ReDim vresult(1 To I) Call CombinationsNP(vElements, I, vresult, 1, 1) Next I End Sub Sub CombinationsNP(ByVal vElements As Variant, ByVal P As Long, ByRef vresult As Variant, ByVal iElement As Integer, ByVal iIndex As Integer) Dim I As Long Dim II As Long Dim iSum As Long For I = iElement To UBound(vElements) vresult(iIndex) = vElements(I) If iIndex = P Then iSum = 0 For II = LBound(vresult) To UBound(vresult) iSum = iSum + vresult(II) Next II If iSum = iGblGoldenTotal Then iGblOutputRow = iGblOutputRow + 1 iGblMatchingTotalCount = iGblMatchingTotalCount + 1 Range("H" & iGblOutputRow).Value = "مج " & iGblMatchingTotalCount Range("I" & iGblOutputRow).Resize(, P) = vresult End If Else Call CombinationsNP(vElements, P, vresult, I + 1, iIndex + 1) End If Next I End Sub مرفق الملف فيه تطبيق الكود .. تقبل تحياتي Totals For All Combinations.rar

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

نسأل الله سبحانه وتعالى أن يغفر له و يرحمه .. ويرزق أهله و ذويه الصبر والاحتساب إنّا للّه و إنّا إليه راجعون

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

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

الأخ الحبيب حسام عيسى بارك الله فيك على هذه اللفتة الكريمة بالترحيب بأخونا ومعلمنا جعفر ونرحب به بيننا ونمتنى تواجده الدائم بيننا ، فالله وحده يعلم كم كنت أتمنى هذا الأمر بشدة ، فلله الحمد والمنة بالفعل أخي جعفر نورت المنتدى ، ليست مجرد كلمة تقال ، ولكنك بالفعل نوارة المنتدى أسأل الله العظيم أن يجمع بيننا في الفردوس الأعلى في مستقر رحمته

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

بسم الله الرحمن الرحيم..السلام عليكم ورحمة الله وبركاته منذ مدة أفتقد مشاركات شخص عزيز وغالي كان يؤجج المنتدى بفعالية صاخبة ...لا تجد ملفاً أو مشاركة إلا وله بها باع طويل... وفي الليلة الظلماء يفتقد البدر....هل علمتم من أقصد ؟؟!. إنه الأخ الحبيب والولد النجيب ياسر خليل أبو البراء...أعزك الله في كل الموجودين الخير والبركة .أما حين تغيب يصبح لون المنتدى باهتاً عندما يغيب منه القلم الأحمر النشط عسى المانع خيراً... نرجو الله أن تكون بيننا عما قريب...وقد لاحظت أخي الحبيب بفضل الله المنتدى ازدادت فعالياته وهمة ونشاط الزملاء الأعضاء فيه راجياً لكم جميعاً التوفيق والسداد. والسلام عليكم ورحمة الله وبركاته.

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

استاذى الحبيب السطر المذكور غير واضح لا بد من ارفاق الملف حتى يتثنى لنا شرح ما تريد ولكن على حسب ما فهمت من سؤالك Dim lr As Range set lr= Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) مثال أنا عندى بيانات ممتلئه بالخلايا A1:A5 وعايز البيانات الجديده تنزل فى الخلية a6 فلازم اعرف اخر سطر به بيانات وهو a5 ثم اضيف له 1 لنصل الى A6 هنا LR هى متغير وقلنا انه يساوى (Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0 (وذالك حتى يتم كتابة LR فىما بعد بالكود بدلا من الجمله دى كلها (Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0 اول جزئية وهى (Cells(Rows.Count, 1 cells تعنى الخليه واى خلية عند قرائتها لابد من اسم العمود ورقم الصف مثلا A1 تعنى الخلية اللى موجوده بالعمود A والصف 1 فى الكود انا عايز اشير الى اخر خليه بها بيانات فتنسيق كتابة الخليه كالتالى (العمود,الصف) Cells لذالك كتبنا (Cells(Rows.Count, 1 هنا رقم الصف غير معروف فقلنا بالكود Rows.Count اى عمل احصاء لعدد الخلايا الممتلئه بالبيانات فى العمود وطبعا العدد هيكون 5 العمود هو رقم 1 وممكن يكتب هكذا "A" اسم العمود داخل علامات تنصيص ( اذن هناك خيارين كتابة رقم العمود مثل 1 أو كتابة اسم العمود مثل "A" ) النتيجة طبقا للسابق هى (5,1) Cells ( يعنى الخلية الموجوده بالصف 5 والعمود 1 ) وهى A5 طيب انا بلف دا كله علشان اوصل الى الخلية A5 ليه علشان اقول له هى اخر خليه بها بيانات فنقوم باضافه (End(xlUp. Cells(Rows.Count, 1).End(xlUp) طيب دلوقتى الكود فهم ان اخر خليه بها بيانات هى A5 أنا بقى عايز انزل البيانات الجديده بالخلية A6 فبقوم بأضافه (Offset(1, 0. (Offset(1, 0. يعنى من الخلية A5 تحرك بمقدار صف واحد ونفس العمود وهو بمثالنا A وبكدا الكود هيوصل الى الخلية A6 السطر هيكون كدا Dim lr As Range set lr= Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) اتمنى اكون وفقت بالشرح وهى استفسار انا تحت امرك تقبل تحياتى

الأخ الحبيب جلال محمد بارك الله فيك وجزاك الله خير الجزاء الأخ ياسر جزيت خيرا على هذا الملف الرائع فهو يحوي الدرر .. تفضلوا إخواني الإصدار الأخير من المكتبة ..فيها مجموعة جديدة أخرى من الأكواد Codes Library v1.4.rar

اخي ياسر السلام عليكم ارجو ان تقبل مني هذة المشاركة ارجوا من الله العلي القدير ان يجعل اعمالك في موازين حسناتك وان ينفع بها الناس Codes Library v1.3.rar

اساتذتى الافاضل / الاستاذ /ضاحى الغريب الاستاذ / شوقى ربيع بارك الله فيكم ومشكورين على هذا العمل الطيب وزادكم الله من علمه ونفع بكم المؤمنين ولكن سامحونى باعتبار انى محاسب وعملت على كتير من البرامج المحاسبية لى بعض الملاحظات على البرنامج 1-البرنامج لا يوجد به تعريفات للحسابات اى شجرة حسابات وميزان مراجعه وقائمة مركز مالى والارباح وخسائر والاصول وما ادراك من الاصول 2-عملية تسجيل سند قبض او صرف يمكن للمستخدم ان يكتب اى اسم كيفما يشاء ولكن المنطق ان يكون هناك قائمة منسدله مثلا يعرض بها اسماء حسابات تم تعريفها من قبل مثلا اسم عميل يكون تم اضافته بشاشة اضافه عميل ثم عند عمل سند قبض وصرف يجبر المستخدم من الاختيار من الحسابات المعرفه مسبقا ولا يكتب اسم اخر هذا بعد النظره الاولى للبرنامج ولكن سوف اجربه باتقان ان شاء الله واسف على الملاحظات ولكن يشهد الله ان ما قلته هو للوصول الى افضل برنامج محاسبى يفيد الشركات والمحاسبين ويكون من اعمالكم الطيبة ومن الصرح العظيم اوفيسنا تقبلوا وافر احترامى وتقديرى