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

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

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

كما  انك  تطلب  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

اما  هذه  الجزئية  لم افهمها  اطلاقا   نحتاج  منك  مزيد  من  التفصيل 

اقتباس

ابحث عن كود اذا ادخلت تاريخ معين فى اى خانه مثلا 21/9/2022 يظهر اليوم " الاربعاء " تلقائي   خانة اخرى 

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