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

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

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

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

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

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

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

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

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

اخى الكريم جرب المرفق وابدى ملاحظاتك تتا.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

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

الاخ الحبيب جرب المرفق هل هو طلبك تم عمل زر واحد فقط للسريل والحدود ان شاء الله ينال اعجابك هذا هو الكود المستخدم 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

شكرا يالصقر

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

انالله وانا اليه راجعون. نسال الله سبحانه ان يتغمده بواسع رحمته

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

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

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

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

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

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

السلام عليكم ورحمة الله بعد إذن اخواني الافاضل هذا حل بطريقة أخرى مختصرة بسطر واحد 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

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