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

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

أخي الكريم سليم بارك الله فيك وهذه دالة معرفة أبسط تقوم بالمهمة Public Function strReverse(ByVal cell As Range) As String strReverse = VBA.strReverse(cell.Value) End Function

أخي الكريم صلاح تم تجربة الملف المرفق من قبلك ويعمل بشكل جيد .. الكود يقوم بإزالة المسافات الزائدة في بداية أو نهاية النص فقط ولكن لإزالة المسافات في وسط النصوص يتم التعديل بإضافة كلمة Application ثم يتبعها نقطة ثم اسم الدالة ليصبح الكود بهذا الشكل Sub RangeVariable() Dim R1 As Range For Each R1 In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) R1.Value = Application.Trim(R1.Value) Next R1 End Sub تقبل تحياتي

أخي الكريم مرسال ما زلت أتمنى تغيير اسم ظهورك للغة العربية (راجع موضوع التوجيهات التوجيه العاشر) الحمد لله أن تم المطلوب على خير .. بالنسبة لطلبك الأخير ..قم بحذف سطر الرسالة MsgBox "تم إعداد تقرير للموظف " & Cells(lRow, "C").Value & " في ورقة التقرير", 64 وضع سطر يشير إلى ورقة التقرير .Activate تقبل تحياتي

أخي الكريم محمد لابد من ملف مرفق معبر عن الملف الأصلي حتى تكون النتائج صحيحة في حالة التجربة ارفق الملف الأصلي .. لنحاول من جديد في موضوعك

أخي الكريم السيفاني نعم المدى أو النطاق يتم تعيين متغير له .. وهذا هو الأصل لأنه في كثير من الأحيان يتم التعامل مع نطاقات مجهولة بالنسبة إلينا .. فمثلاً لنفترض انك ستقوم بالتعامل مع الخلايا في العمود الأول من الصف الأول إلى آخر صف به بيانات ..فيمكن استخدام حلقة تكرارية لكل خلية (والخلية تعتبر نطاق في حد ذاتها) ..وذلك لتنفيذ شيء معين على الخلايا أو النطاقات .. لذا يمكن استخدام المتغير باسم R1 ليعبر عن كل خلية أو نطاق داخل العمود ...بهذا الشكل Dim R1 As Range ثم لعمل حلقة تكرارية لكل كائن أو خلية أو نطاق داخل النطاق الأكبر في العمود الأول يمكن استخدام السطر التالي الذي سيتعامل مع النطاق بدءاً من الخلية A1 وحتى آخر خلية بها بيانات في العمود الأول .. For Each R1 In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) Next R1 وما بين جزئي الحلقة التكرارية يتم تنفيذ أسطر الكود لكل خلية أو كائن أو نطاق على حدا .. لنفترض أن هناك مسافات زائدة في بداية النص أو نهايته .. جرب السطر التالي ليتم التعامل مع الكائن بأن يعطي أمر بإزالة المسافات باستخدام الدالة TRIM .. ليصبح السطر بهذا الشكل R1.Value = Trim(R1.Value) وأخيراً يصبح الشكل الكامل للكود بهذا الشكل Sub RangeVariable() Dim R1 As Range For Each R1 In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) R1.Value = Trim(R1.Value) Next R1 End Sub أرجو أن تكون الصورة قد اتضحت

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

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

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

ممكن تحدد أرقام الصفوف المراد اخفائها بالضبط ..لكي يسهل الوصول لحل تقبل تحياتي

أخي الكريم عاشق الإكسيل كنت أتمنى أن تقوم بإضافة كود ولو بشكل مبدئي وليس كامل لتستطيع أن تقوم بالأمر بنفسك عموماً جرب الكود التالي وشوف هل يؤدي الغرض أم أن هناك مشاكل به Sub EditAfterRecall() Dim WS As Worksheet, SH As Worksheet Dim TargetRow As Long, LR As Long, RowsToInsert As Long Dim LastRow As Long, I As Long, Arr Set WS = Sheet1: Set SH = Sheet3 If IsError(Application.Match(WS.[M5].Value, SH.[A1:A2000], 0)) Then MsgBox "رقم الإذن غير موجود في ورقة الأرشيف", 64: Exit Sub Else With Application .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False End With TargetRow = Application.Match(WS.[M5].Value, SH.[A1:A2000], 0) LR = IIf(SH.Range("A" & TargetRow).End(xlDown).Row >= Rows.Count, SH.Range("I" & Rows.Count).End(xlUp).Row + 1, SH.Range("A" & TargetRow).End(xlDown).Row) SH.Rows(TargetRow & ":" & LR - 1).Delete Shift:=xlUp RowsToInsert = Application.WorksheetFunction.CountA(WS.Range("F20:F33")) SH.Rows(TargetRow).Resize(RowsToInsert).Insert Shift:=xlDown With SH.Rows(TargetRow).Resize(RowsToInsert) .Interior.Color = xlNone .Font.ColorIndex = xlAutomatic .Font.Size = 13 End With 'ترحيل البيانات LastRow = WS.Cells(33, "F").End(xlUp).Row Arr = Array("M5", "M2", "D6", "C10", "C12", "C16") For I = 0 To UBound(Arr) If IsEmpty(WS.Range(Arr(I))) Or LastRow < 20 Then MsgBox "البيانات غير مكتملة", vbCritical: Exit Sub Next I For I = 0 To UBound(Arr) SH.Cells(TargetRow, I + 1) = WS.Range(Arr(I)) Next I WS.Range("P20:R" & LastRow).Copy SH.Range("G" & TargetRow).PasteSpecial xlPasteValues MsgBox "تم تعديل البيانات بنجاح", 64 With Application .CutCopyMode = False .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True End With End If End Sub تقبل تحياتي

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

أخي الكريم تحيا مصر جرب الكود التالي عله يفي بالغرض .. Sub Test() Dim StrCode As String, StrDay As String Dim FoundCode As Range, FoundDay As Range Dim Col As Integer, Row As Integer StrCode = Range("T12").Value StrDay = Range("U12").Value On Error Resume Next Set FoundCode = Columns(1).Find(StrCode, LookIn:=xlValues, LookAt:=xlWhole) Set FoundDay = Range("E2:P2").Find(StrDay, LookIn:=xlValues, LookAt:=xlWhole) Row = FoundCode.Row: Col = FoundDay.Column + 1 Cells(Row, Col).Value = Range("X17").Value End Sub تقبل تحياتي

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

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

الأخ الكريم رميلي كمال إليك الملف غير محمي وأرجو ألا يكون تعدي على حقوق الغير CERTIFICAT.rar

وعليكم السلام أخي وحبيبي في الله سعيد بيرم أدام الله المحبة بيننا في الله جرب الكود التالي حسب ما فهمت ..للأسف أنا لا أجيد الفهم في كثير من الأحيان .. ولكن حسب ما فهمت جرب الكود التالي وقد تم التعديل على بعض أجزاء الكود .. Sub Print_All() Dim Sh As Worksheet, LR As Long Dim Stx1 As String, Stx2 As String, St1 As String, St2 As String Dim Texte1 As String, Texte2 As String Set Sh = Sheets("فاتورة") LR = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row Stx1 = "جنيها ": Stx2 = "قرشا ": St1 = "و ": St2 = "لاغير" Texte1 = NoToTxt2(Cells(LR, "J")) Texte2 = NoToTxt2(Cells(LR, "I")) Range("del_range").NumberFormat = ";;;" ActiveSheet.PrintOut Copies:=1 With Cells(LR + 1, "B") .Value = "إجمالى الفاتورة : " .HorizontalAlignment = xlLeft If Cells(LR, "I") = 0 Then .Offset(, 1).Value = "فقط " & Texte1 & Stx1 & St2 Else .Offset(, 1) = "فقط " & Texte1 & Stx1 & St1 & Texte2 & Stx2 & St2 .HorizontalAlignment = xlRight End With Range("del_range").NumberFormat = "00" ActiveSheet.PrintOut Copies:=2 Range(Cells(LR + 1, "B"), Cells(LR + 1, "C")) = "" End Sub تقبل تحياتي

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

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

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

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

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

أخي الحبيب الغالي حسام خطاب أحبك الله الذي أحببت فيه أخاك .. تقبل وافر تقديري واحترامي

عفواً أخي الكريم نايف المهم أن تم المطلوب على خير .. وإلى لقاء في موضوع آخر تقبل تحياتي

الحمد لله الذي بنعمته تتم الصالحات الحمد لله أن تم المطلوب على خير