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

اطلع على الرابط التالي لعله يفيدك من هنا

وعليكم السلام غير اتجاه الكتاية وسيتغير معك شكل الأرقام في كل مرة ..

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

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

أخي الكريم الدالة صحيحة والنتائج لدي سليمة تأكد أنه عندما قمت بنسخ الدالة المعرفة من المشاركة أن اتجاه الكتابة باللغة العربية ليتم نسخ الحروف العربية بشكل صحيح .. حيث تحتوي الدالة على حرفي الـ ع و ح بارك الله فيك أخي الغالي بن عليه وجزيت خيراً

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

وعليكم السلام جرب الدالة المعرفة التالية Function SumIt(rng As Range) Dim c As Range Dim counter As Double Dim x As Variant Dim i As Long Dim z As Double counter = 0 For Each c In rng x = Split(c, "+") For i = LBound(x) To UBound(x) If x(i) = "ح" Then z = 800 ElseIf x(i) = "ع" Then z = 1000 ElseIf IsNumeric(x(i)) Then z = x(i) * 200 End If counter = counter + z Next i Next c SumIt = counter End Function لاستخدام الدالة قم بوضع المعادلة التالية في الخلية H2 ثم اسحبها لأسفل =SumIt(B2:F2)

وعليكم السلام أخي الكريم أي نظام تقصد التصدير منه؟ عموماً جرب تنسق الخلايا التي سيتم التصدير إليها كنص Text إذا لم يتم حل المشكلة قم بإرفاق نموذج مصغر من ملفك للإطلاع عليه ، حيث يوجد أكثر من حل لهذه المشكلة تقبل تحياتي

جرب بقية الحلول بضرب التاريخ في 1 مثلاً أو استخدام DateValue .. حتى تصل لحل المشكلة بشكل نهائي والحمد لله أن توصلت لنصف الحل ، وإن شاء الله تصل للحل بشكل نهائي تقبل تحياتي

وعليكم السلام ورحمة الله وبركاته

وعليكم السلام اشرح المشكلة بالصور أو ارفق ملف لكي تجد استجابة أفضل لموضوعك

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

هذين السطرين يقعان داخل حلقة تكرراية .. وهذا يسبب المشكلة التي تعاني منها حيث يقوم الكود في كل مرة بحفظ المصنف الحالي ثم إغلاقه ActiveWorkbook.Save ActiveWorkbook.Close

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

جرب الكود التالي Option Explicit Dim rng As Range Private Sub SpinButton1_SpinDown() If Val(TextBox1.Value) <= 1 Then Exit Sub TextBox1.Value = Val(TextBox1.Value) - 1 End Sub Private Sub SpinButton1_SpinUp() If Val(TextBox1.Value) >= Cells(Rows.Count, 1).End(xlUp).Row - 1 Then Exit Sub TextBox1.Value = Val(TextBox1.Value) + 1 End Sub Private Sub TextBox1_Change() On Error Resume Next Set rng = Range("A2:D" & Cells(Rows.Count, 1).End(xlUp).Row) TextBox2.Value = Application.WorksheetFunction.VLookup(Val(TextBox1.Value), rng, 2, 0) TextBox3.Value = Application.WorksheetFunction.VLookup(Val(TextBox1.Value), rng, 3, 0) TextBox4.Value = Application.WorksheetFunction.VLookup(Val(TextBox1.Value), rng, 4, 0) End Sub

جرب الكود التالي (للملفات التي تبدأ الرقم 30) ، ونفس الكود مع الملفات التي تبدأ بـ 40 (التغيير في الرقم فقط) Sub LoopClosedWBs() Dim strPath As String Dim strFile As String Dim wbk As Workbook Dim wsh As Worksheet Dim col As Long Application.ScreenUpdating = False ActiveSheet.Cells.Clear strPath = ThisWorkbook.Path & "\Data\" strFile = Dir(strPath & "30*.xls*") col = 1 Do While strFile <> "" Set wbk = Workbooks.Open(strPath & strFile) Set wsh = wbk.Worksheets(1) wsh.Range("A1:A2").Copy ThisWorkbook.Sheets(1).Cells(1, col) col = col + 1 wbk.Close SaveChanges:=False strFile = Dir Loop Application.ScreenUpdating = True End Sub يمكن أن يظهر معك خطأ بسبب أسماء بعض الملفات (30 WithNewWord و 30 WithWord) حيث حرف الـ i خطأ ويتسبب في ظهور خطأ فقم إصلاح أسماء الملفات قبل تنفيذ الكود الكود لن ينسخ البيانات بنفس الترتيب الذي أرفقته ، وإذا أردت أن يرتب بنفس الترتيب قم بإعطاء أرقام متسلسلة للملفات بعد الرقم 30 مثلاً 30_001 و 30_002 وهكذا تقبل تحياتي

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

ضع أسطر الكود بدون العنوان وبدون النهاية داخل الكود الخاص بحدث المصنف .. >> من نافذة المشروع >> اعمل دبل كليك على الكائن ThisWorkbook ، ثم اختر من القوائم المنسدلة الكائن Workbook من الجهة اليسرى والحدث Open من الجهة اليمنى ثم ضع أسطر الكود بداخله كما بالصورة التالية

وعليكم السلام هل أنت متأكد أنك اطلعت على الدرس بشكل جيد ...!! عموماً جرب الكود التالي Sub Test() Dim ws As Worksheet For Each ws In Sheets(Array("1", "2", "3", "4", "Observations")) ws.Visible = False Next ws End Sub وللإظهار قم بتغيير القيمة False إلى القيمة True

اطلع على أسطر الكود واستبدل النص Dollar إلى K.D ، والنص Cent إلى Fils

بارك الله فيك أخي الكريم ناصر ومشكور على كلماتك الطيبة تقبل تحياتي

السلام عليكم أخي الكريم ناصر حسان اطلع على الرابط التالي فيه شرح ما تطلبه إن شاء الله رابط الموضوع من هنا

في انتظار تجربتك إن شاء الله

يمكن في الكود الخاص بالنسخ إظهار ورقة العمل قبل النسخ ثم بعد النسخ يمكن إخفاء ورقة العمل راجع الرابط التالي لمعرفة كيفية إخفاء وإظهار أوراق العمل الرابط من هنا