ياسر خليل أبو البراء

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

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

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

أخي الكريم أحمد محمد العباسي إليك الكود التالي كما طلبت Sub Tarhil() Dim WS As Worksheet, SH As Worksheet, LR1 As Integer, LR2 As Integer, Cel As Range Set WS = Sheet11: Set SH = Sheet6 LR1 = WS.Cells(86, "G").End(xlUp).Row LR2 = SH.Cells(Rows.Count, "A").End(xlUp).Row + 1 If LR1 < 8 Then MsgBox "There Is No Data", 64: Exit Sub Application.ScreenUpdating = 0 WS.Range("G8:K" & LR1).Copy SH.Range("A" & LR2).PasteSpecial xlPasteValues If MsgBox("هل تريد مسح محتويات الفاتورة بعد أن تم الترحيل؟", vbQuestion + vbYesNo) = vbYes Then For Each Cel In WS.Range("G8:K" & LR1).SpecialCells(xlCellTypeConstants) Cel.ClearContents Next Cel WS.Range("K35,K37").ClearContents Else MsgBox "لم يتم مسح محتويات الفاتورة بعد الترحيل", 64 End If Application.CutCopyMode = False Application.ScreenUpdating = 1 End Sub وإليك الملف المرفق مطبق فيه الكود مع تعديل طفيف في معادلات العمود الخاص بالسعر والإجمالي حتى لا يظهر خطأ في حالة مسح البيانات الأخرى جرب الملف وأعملنا بالنتيجة شركه العباسى.rar

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

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

أخي الغالي سليم بارك الله فيك على هداياك المميزة لقد قمت باستخراج أكبر 10 درجات لكل صف ... كمل جميلك واستخرج الـ 10 أسماء المرتبطة بالدرجات ، ولو فيه طالبين ليهم نفس الدرجة يكتب في عمود ثالث الترتيب وبجواره كلمة "مكرر"

أخي الكريم أحمد لابد من تفصيل الأمر قليلاً .. يعني أنت حددت الأعمدة المراد ترحيلها (الصنف وا لسعر والإجمالي) هل هذا فقط ما تريد ترحيله ؟؟ ما هي ورقة العمل المراد الترحيل إليها ؟ وما هي شكل المخرجات .. وما هي الخلايا التي تريد مسحها خلاف الخلايا التي بها معادلات ؟؟

غير القيم في العمود الثالث (عمود الدرجات) وسيتغير الترتيب التلقائي لترتيب الطلبة حسب الدرجات)

طيب هل فيه مشكلة إنك ترفق البرنامج لتجربته ومحاولة تقديم المساعدة بدلاً من الدخول في دائرة افتراضات واحتمالات .. طيب جرب السطر دا في حدث ورقة العمل ThisWorkbook.RefreshAll

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

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

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

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

قم بتغيير الفاصلة العادية الموجودة في المعادلة إلى فاصلة منقوطة

مشكور أبو سليمان الحبيب على الرد الجميل بس بلاش تعرف السعر عشان ممكن تتخض (ولا أقولك اتخض وخلاص !! السعر حوالي 650 جنيه مصري) فينك بقالك فترة مش ظاهر على شاشات أوفيسنا ..خير اللهم اجعله خير ..لعل غيابك خير إن شاء الله تقبل تحياتي

أخي الكريم محي قم بوضع تعليق على هذه الأسطر التي تقوم بفتح مربع حواري لاختيار الملف منها ' Set FD = Application.FileDialog(msoFileDialogOpen) ' FD.Show ' If FD.SelectedItems.Count <> 0 Then ' FName = FD.SelectedItems(1) ' Else ' Exit Sub ' End If وضع هذا السطر .. قبلها أو بعدها (مش هتفرق) FName = Sheet2.Range("A1").Value ممكن ترفق ملف الورد المستخدم في مثالك للإطلاع عليه والاستفادة منه تقبل تحياتي

أخي الكريم أبو عبد الله جرب المعادلة التالية في الخلية D2 =COUNTIFS(B$2:B$110,B2,C$2:C$110,">"&C2)+1 تقبل تحياتي

جرب السطر بهذا الشكل Sheets("nn").Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1) = TextBox1.Text

أخي الكريم أحمد أهلاً بك في المنتدى ونورت بين إخوانك .. يرجى تغيير اسم الظهور للغة العربية كما يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى يراعى عند طرح موضوع أن يكون مصحوب بملف مرفق لتتضح الصورة ولتسهل المساعدة على إخوانك بالمنتدى إليك مثال مبسط فيه خليتين أحدهما B5 خلية بها نص وليست معادلة ، والخلية الأخرى D5 هي معادلة يتم الترحيل للخليتين ثم بعد الترحيل يتم مسح الخلية التي بها نص أما الخلية التي بها معادلة فلا يتم مسح بياناتها أرجو أن يكون المطلوب Sub Tarhil() Dim WS As Worksheet, SH As Worksheet, LR As Integer, Cel As Range Set WS = Sheet1: Set SH = Sheet2 LR = SH.Cells(Rows.Count, "A").End(xlUp).Row + 1 SH.Cells(LR, "A").Value = WS.Cells(5, "B").Value SH.Cells(LR, "B").Value = WS.Cells(5, "D").Value For Each Cel In Range("B5,D5") If Not Cel.HasFormula Then Cel.ClearContents Next Cel End Sub تقبل تحياتي ClearContents For Constants Only YasserKhalil.rar

أخي الكريم أبو عبد الله هذه ليست مشكلة إنما النطاق الذي تعمل فيه تم تحويله لجدول .. ولذا تظهر بهذا الشكل .. يمكنك الإشارة إلى الخلايا بشكل مباشر كما تعودت عن طريق كتابة اسم الخلية (اسم العمود ورقم الصف) بشكل يدوي أو تحويل الجدول إلى نطاق عادي : قف في أي خلية في الجدول ستجد تبويب جديد ظهر باسم Design قم بالنقر على الأمر Convert To Range ستظهر رسالة انقر Yes وببس خلاص الجدول بح .. يمكنك استرجاع الجدول مرة أخرى عن طريق تحديد النطاق المطلوب تحويله لجدول ثم من التبويب Insert اختر الأمر Table ثم OK تقبل تحياتي

تفضل أخي الكريم ممدوح (وبلاش اللي بالي بالك ..) راجع التوجيهات في الموضوعات المثبتة في صدر المنتدى Protect Workbook & Prevent Editing After Specific Date YasserKhalil.rar

جرب الكود التالي في حدث المصنف Private Const ExpirationDate As Date = #1/31/2015# Private Sub Workbook_Open() ThisWorkbook.Worksheets("Sheet1").Unprotect Password:="123" If CDate(Now) >= CDate(ExpirationDate) Then ThisWorkbook.ChangeFileAccess (xlReadOnly) ThisWorkbook.Worksheets("Sheet1").Protect Password:="123", UserInterfaceOnly:=True End If End Sub جرب أن تغير التاريخ إلى تاريخ أحدث وليكن 31 / 1 / 2016 على أن يكون الشهر في البداية يليه اليوم ثم السنة كما هو مبين بالكود عاليه تقبل تحياتي

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

أخي الكريم إليك الكود التالي لعملية الترحيل يتم الاعتماد على رقم الإذن بحيث يكون غير مكرر في ورقة الأرشيف ... لا يتم الترحيل إذا كانت البيانات غير مكتملة أرجو أن يفي بالغرض Sub TransferData() Dim WS As Worksheet, SH As Worksheet Dim LastRow As Long, LR As Long, I As Long Dim Arr, Found Set WS = Sheet1: Set SH = Sheet3 LastRow = WS.Cells(33, "F").End(xlUp).Row LR = SH.Cells(Rows.Count, "I").End(xlUp).Row + 1 Arr = Array("M5", "M2", "D6", "C10", "C12", "C16") With Application .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False End With For I = 0 To UBound(Arr) If IsEmpty(WS.Range(Arr(I))) Or LastRow < 20 Then MsgBox "البيانات غير مكتملة", vbCritical: Exit Sub Next I Set Found = SH.Columns(1).Find(What:=WS.Range("M5").Value, LookAt:=xlWhole) If Not Found Is Nothing Then MsgBox "تم ترحيل الإذن من قبل", 64: Exit Sub For I = 0 To UBound(Arr) SH.Cells(LR, I + 1) = WS.Range(Arr(I)) Next I WS.Range("P20:R" & LastRow).Copy SH.Range("G" & LR).PasteSpecial xlPasteValues With Application .CutCopyMode = False .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True End With MsgBox "تم ترحيل البيانات بنجاح", 64 End Sub تقبل تحياتي Transfer Data Using Arrays YasserKhalil.rar