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

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

السلام عليكم ورحمة الله وبركاته الدرس الاول 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

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

بارك الله فيك اخي ياسر .... اتمنى لك كل التوفيق

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

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

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

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

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

اخى الكريم جرب المرفق وابدى ملاحظاتك تتا.rar تتا.rar

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

الأمر ممكن وبكل سهولة بعد تعديل البيانات اضغط زر الحفظ جرب المرفق 3 datamastar.rar

وعليكم السلام ورحمة الله وبركاته هذا الكود الاول Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 91 Then If Target.Column = 35 Then Sheets("ELS").Cells(Target.Row - 86, "P").Value = Sheets("ELS").Cells(Target.Row - 86, "N").Value Sheets("ELS").Cells(Target.Row - 86, "N").Value = Sheets("ELS").Cells(Target.Row - 86, "L").Value Sheets("ELS").Cells(Target.Row - 86, "L").Value = Sheets("ELS").Cells(Target.Row - 86, "J").Value Sheets("ELS").Cells(Target.Row - 86, "J").Value = Sheets("ELS").Cells(Target.Row - 86, "H").Value Sheets("ELS").Cells(Target.Row - 86, "H").Value = Target.Value End If If Target.Column = 36 Then Sheets("ELS").Cells(Target.Row - 86, "Q").Value = Sheets("ELS").Cells(Target.Row - 86, "O").Value Sheets("ELS").Cells(Target.Row - 86, "O").Value = Sheets("ELS").Cells(Target.Row - 86, "M").Value Sheets("ELS").Cells(Target.Row - 86, "M").Value = Sheets("ELS").Cells(Target.Row - 86, "K").Value Sheets("ELS").Cells(Target.Row - 86, "K").Value = Sheets("ELS").Cells(Target.Row - 86, "I").Value Sheets("ELS").Cells(Target.Row - 86, "I").Value = Target.Value End If End If End Sub وهذا الكود الثاني Function ContDate(MyDate1 As Date, MyDate2 As Date, YMD As String) D1 = Day(MyDate1): D2 = Day(MyDate2) M1 = Month(MyDate1): M2 = Month(MyDate2) Y1 = Year(MyDate1): Y2 = Year(MyDate2) If D1 > D2 Then Dr = D2 + 30 - D1: M = -1 Else Dr = D2 - D1 If M1 > M2 Then Mr = M2 + M + 12 - M1: Y = -1 Else Mr = M2 - M1 Yr = Y2 - Y1 + Y If YMD = "D" Or YMD = "d" Then ContDate = Dr If YMD = "M" Or YMD = "m" Then ContDate = Mr If YMD = "Y" Or YMD = "y" Then ContDate = Yr End Function وهذي المعادلات IFERROR(MID(YEAR IF(ISERR IFERROR(VLOOKUP وغيرها من المعادلات جميعها في قاعدة بيانات واحدة وجميعها اخذتها من أسئلتي في هذا الصرح الشامخ وبمعونة الله ثم الاساتذة الكرام بهذا المنتدى المميز

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

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

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

السلام عليكم...لفتة كريمة من أخ كريم لأخ كريم كان ينشر العلم النافع . جزاكم الله خيرا....

الله يرحمه ويتغمده برحمته

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

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

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

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

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذنا الفاضل ابراهيم أبو ليله على الفكرة الّتي هي فعلاً في أكثر من محلّها .. وفّقك الله و سدّد خطاك لما يحبّه و يرضاه خالص احتراماتي

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

هل من طريقة اخري لتحويل ارقام الى عملات جزائرية مثال 100,00مائة دينار جزائريا وجب ان تكتب دينار جزائريا

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

استاذى الحبيب السطر المذكور غير واضح لا بد من ارفاق الملف حتى يتثنى لنا شرح ما تريد ولكن على حسب ما فهمت من سؤالك 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) اتمنى اكون وفقت بالشرح وهى استفسار انا تحت امرك تقبل تحياتى

أخى الفاضل وأستاذي الكريم لست اجيد الشرح فقمت بعمل ملف به بعض الأكواد التى أتمنى منك اضافتها للمكتبة وهي كود تحديد القيم 0 وتلوينها كود تلوين الصفوف الفارغة في نطاق محدد كود منع ال Right-Click او ال Double-Click داخل الشيت كود تلوين الخلية بالأحمر عند الضغط عليها Double-Click كود تلوين القيم الفريدة والقيم المكررة داخل نطاق محدد كود تلوين الخلايا الفارغة في نطاق محدد كود تلوين الخلايا التى بها قيم وتجاهل الفارغة كود تلوين الخلايا التى بها أخطاء كود ازالة التنسيق الشرطي السابق من النطاق كود جعل علامة X (الاغلاق ) بالفورم غير نشطة كود تقسيم الاوراق الى ملفات منفصلة حاجات خفيف خفيف كده، وأول الغيث قطرة، وعذرا للتأخير، مرفق الملف زبط بقي على كيفك وضيف ما تريده للمكتبة تحياتي Codes.rar

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range) Static OldCell As Range If Not OldCell Is Nothing Then OldCell.Interior.ColorIndex = xlColorIndexNone End If Target.Interior.ColorIndex = 6 Set OldCell = Target End Sub السلام عليكم اخي الحبيب ابو البراء زادكم الله من فضله علما وشرفا هذه مشاركة بسيطة عشان ماتبقاش جنب الجهاز بخاف على نظرك انت عزيز علينا وهو كود تلوين الخلية النشطة تقبلوافائق احترامي وتقديري

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

السلام عليكم ورحمة الله ولإثـــــــراء المكتبه هذا كود لاحظت الكثير يسألوا ويبحثوا عنة ولم يلقوا إجابه وهذا الكود يقوم بحذف الملف نهائيا بعد إستخدامة 3 مرات مع إمكانية تغيير العدد الملف يحذف نفسه تلقائيا بعد 3 استعمالات و يشعر المستخدم بعد الحذف.rar

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

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