عبدالفتاح في بي اكسيل

هل جربيت الرابط الذي زودتك به

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

حسنا تتجاهل اجابتي لم تقل اذا كانت تعمل معك ام لا . انتظر المساعدة من شخص اخر .

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

حقيقية لم اجرب هذا الشيء من قبل, ولكن هل يتم سحبها من الانترنت ام تقوم بادخال يدوي اما ماذا ؟

@goodlife اعتقد ان موضوعك خرج خارج السياق الاصلي لطلبك يبدو من الصورة البيانات يتم جلبها من موقع الانترنت وهذا موضوع بعيد كل البعد عن موضوعك الاصلي .

مجرد تخمين بناء على كلامك ..احدف هذه الاسطر في نهاية الكود Me.txt_product.Value = "" Me.txt_price_sale.Value = "" Me.txt_price_pru.Value = ""

يجب ان تكون متوفر عادة ولكن قم بازالة OLE automation ثم تحديده ثم اغلق الملف بعد حفظه وافتحه من جديد وابحث عن الاداة من داخل محرر الاكواد من قائمة refernce>tools >OLE automation وهذ ا موضوع مشابه كنت قد اجبت عليه احد الاعضاء يمكنك الاطلاع عليه واعلامي ماذا يحدث معك . https://www.officena.net/ib/topic/102575-كود-كليندر-يعمل-على-اوفيس-2003ولايعمل-على2013/#comment-618610 تحياتي .

@Muner انا لم اجد اي منفعة مما تطلبه . ما الغرض منه ؟؟ الطريقة المثلى هو ان تضع الجدول في الاسفل ابتداء من الصف السابع اذا كنت تريد عمل فاصل بين الجدولين اما الجدول الاول لا يوجد صفوف فارغة فقط تحدد اخر خلية معبئة في العمود F ومن تم انتر فيدرج لك الصف الذي تحتاجه في كل مرة تكرر العملية على حسب احتياجك من الصفوف.

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

@Mohamed Hicham لماذا تستخدم الحلقة التكرارية وخاصية اختيار الملفات ؟ من شانه ان يجعل الكود بطيء ، دائما نلجا الى الفلترة او الفلترة المتقدمة لسرعتها خصوصا ان بيانات الاخ tahar صغيرة اما اذا كانت البيانات ضخمة عندها نستخدم الحلقة التكرارية مع المصفوفات لتسريع الكود. مجرد ملاحظة فقط ..تحياتي .

اخي الكريم ...وكيف سنعرف نوعية الخطا اذا انت لم تحدده. حقيقة لم استعمل هذه الاداة من قبل لكن اذا كنت تقصد هذا الخطا "compile erro function not defined" في هذه الحالة يجب ان تتاكد من تقعيل هذه الاداة من خلال قائمة خيارات الملف والذهاب الى الوظائف الاضافية adds in ويظهر لك مجموعة خيارات ابحث عنها وفعلها وستظهر لك القائمة وستجدها وفعلها ثم ادخل الى محرر الاكواد ومن قائمة tool >reference > solver قم بتحديدها اما اذا كان خطا اخر فعليك توضيح ذلك و لاتضع سؤال عشوائي لا احد يعلم ما هو الخطأ . تحياتي

اخي الكريم انا اجبتك على سؤالك ، هل بعد الاجابة تطلب مني طلب اخر لا علاقة له بمشكلتك الم تقرا التوقيع في الاسفل ؟؟؟ معظم الاعضاء الذين يطلبون التعديل اتجاهل طلبهم ولا ادخل في مواضيعهم لكثرة التعديلات واهدار الوقت . هذه المرة ساتجاوز ذلك .ضع هذا في حدث الورقة التي يتم البحث منها . Private Sub Worksheet_Change(ByVal Target As Range) Dim Fnd As Range If Target.Count > 1 Then Exit Sub If Target.Address(0, 0) = "E3" And Target.Value <> "" Then Set Fnd = ورقة2.Range("C:C").Find(Target.Value, , , xlWhole, , , False, , False) If Fnd Is Nothing Then Application.DisplayAlerts = False MsgBox "رقم الهوية" & " " & Target.Value & " " & "غير موجود ، الرجاء المحاولة مرة اخرى", vbExclamation Application.DisplayAlerts = True Exit Sub End If End If End Sub

اذا كنت تريد المساعدة في المرة القادمة يرجى الاجابة عن الاستفسارات واخذ ملاحظاتي بعين الاعتبار . غير هذا الكود بالكامل وسيختفي الخطا انشاء الله . تم اضافة هذا الجزء بعد اعلان المتغير (المشكلة في الخطا في الخلية التي سألتك عنها ) كما ستلاحظ اذا كانت هناك بيانات سابقة معبئة وكان رقم الهوية فارغ سوف يتم مسحها اذا كان لا يوجد رقم هوية ليس من المنطقي بقاؤها If ورقة2.Cells(2, 16).Text = "#N/A" Then MsgBox "الرجاء تعبئة رقم الهوية ", vbCritical With ورقة1 Range("d5:d13", "g5:g13").ClearContents End With ورقة1.Range("E3").Select Else Private Sub CommandButton2_Click() ورقة2.Range("O2").Value = ورقة1.Range("E3").Value Dim lsearch As Integer If ورقة2.Cells(2, 16).Text = "#N/A" Then MsgBox "الرجاء تعبئة رقم الهوية ", vbCritical With ورقة1 Range("d5:d13", "g5:g13").ClearContents End With ورقة1.Range("E3").Select Else lsearch = ورقة2.Range("P2").Value ورقة1.Range("D5").Value = ورقة2.Cells(lsearch, "B").Value ورقة1.Range("D7").Value = ورقة2.Cells(lsearch, "C").Value ورقة1.Range("D9").Value = ورقة2.Cells(lsearch, "D").Value ورقة1.Range("D11").Value = ورقة2.Cells(lsearch, "E").Value ورقة1.Range("D13").Value = ورقة2.Cells(lsearch, "F").Value ورقة1.Range("G5").Value = ورقة2.Cells(lsearch, "G").Value ورقة1.Range("G7").Value = ورقة2.Cells(lsearch, "H").Value ورقة1.Range("G9").Value = ورقة2.Cells(lsearch, "I").Value ورقة1.Range("G11").Value = ورقة2.Cells(lsearch, "J").Value ورقة1.Range("G13").Value = ورقة2.Cells(lsearch, "K").Value MsgBox "تم استخراج البيانات بنجاح ", vbInformation, "رسالة تأكيد" End If End Sub

اخي الكريم نبهنا مرارا وتكرارا لا تستخدم خلايا مدمجة ثم كيف تستعلم او تحدف على شيء غير موجود في الاساس ثم ماذا تفعل بالصيغة بالخليةP2 في الورقة2 لان المشكلة منها ، هل هي ضرورية ؟ وهل اذا كان رقم الهوية يحتوي على فراغ يعني الكود لايقوم بشيء؟ عليك بنشر تفاصيل كاملة بدلا من طرح سؤال عشوائي !!!

وماذا ستستفيذ من ذلك اذا كان الكومبوبوكس يقوم بذلك . لا ارى الا ان تصعيب الامور من عندك وبالتالي ان تسال عن شيء لا يشكل اي فرق في ذلك .

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

تقضل اخي الكريم ..هذه اعادة صياغة الكود (احذف الاكواد اللي عندك) Private Sub ComboBox1_Change() Dim Name As String Dim sh As Worksheet Dim myrange As Range Set sh = ThisWorkbook.Worksheets("sheet1") Name = Me.ComboBox1.Value Set myrange = sh.Columns(2).Find(Name, LookIn:=xlValues, lookat:=xlWhole) If Not myrange Is Nothing Then With myrange TextBox1.Value = .Offset(, 1) TextBox2.Value = .Offset(, 2) End With End If End Sub امل انه تم اصلاح كل مشاكلك .

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

@حواديتهذه محاولة يوجد طرق اخرى لكان لضيق وقتي اخترت ابسط الطرق قم بانشاء موديل وضع هذا الكود وانظر الى النتيجة اذا كان هذا ما تريده ملاحظة : لا احبذ استخدام اللغة العربية في الاكسيل لانه تسبب مشاكل في الاكواد لعدة عوامل وفي المرة القادمة اذا اردت اكواد عليك ارفاق ملف يقبل الاكواد مثل XLSM Sub test() Dim last_row As Long Dim rng, rng1 As Range last_row = ThisWorkbook.Worksheets("الاكواد").Cells(Rows.Count, 1).End(xlUp).Row Set rng = Range("C3:C" & last_row) Set rng1 = Range("D3:D" & last_row) rng.Formula = "=SUMIF(اليوميه!$A$1:$A$1048575,A3,اليوميه!$C$1:$C$1048575)" rng1.Formula = "=SUMIF(اليوميه!$A$1:$A$1048575,A3,اليوميه!$D$1:$D$1048575)" rng.Value = rng.Value rng1.Value = rng1.Value End Sub تحياتي .

بدلا من ان تقوم بتصميم الملفين قم بتصميم ملف الجداول ومن ثم عن طريق ماكرو تقوم بدمج بيانات ملف الجداول الى ملف جديد (ملف الاستيراد) به ورقة تحتوي على كل الجداول حتى توفر على نفسك وقت تصميم الملفين هذا ان لم اخطأ في فهم مرادك . ملاحظة: لماذا في ملف الجداول كل جدول يبدا من السبت الى الاربعاء ويحتوي على عمود به 0 بينما عند استيراد البيانات في ملف الاستيراد يبدا من الاحد الى الخميس ولا يوجد العمود الذي يحتوي على 0 ( اختلاف في تركيبة الجدول ) ..كيف سيتم الاستيراد في هذه الحالة ؟

لما لا تقوم بدمجهم كلهم بصفحة واحدة في نفس الملف .

مشكلته كانت بسيطة لكن مؤثرة ومحيرة بعض الشيء اسم الورقة الموجودة في الكود ليست نفسه كما في داخل الورقة . من الوهلة الاولى عند النظر اليها تعتقد انها نفس الشيء( لتجنب هكذا مشاكل استخدم خاصية copy & paste) الشي الثاني يجب ايضا ان تشير للورقة لهذا السطر ايضا If Sheet1.Cells(i, 4) - Date >= 0 And Sheet1.Cells(i, 4) - Date <= 30 Then اتمنى ان تكون الامور جيدة الان . تذكير بتاريخ انتهاء العقود.xlsm

بخصوص الاجازة الاسبوعية اضف هذا في نهاية الكود وانظر كيف تعمل معك If Target.Column = 1 Then If Target.Value = "السبت" Then Target.Offset(, 4) = "اجازة اسبوعية" End If End If اما هذه الجزئية لم افهمها اطلاقا نحتاج منك مزيد من التفصيل

وعليكم السلام .لماذا لم تجد المساعدة لانك لم تضع النتائج المتوقعة للحالات التي ذكرتها كما دائما نبهنا بعدم دمج الخلايا .بالتوفيق