تصحيح كود

[ابو حمادة]

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

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

MsgBox "هذه الرساله عند تشغيل الكود تظهر مرتين ورا بعض اريدها تظهر مره واحده فقط"

 

Private Sub A5_Change()
Dim ws As Worksheet
Set ws = Worksheets("Archives_Bill")
If ComboBox2.Text = "" Then
MsgBox ("ÇáÑÌÇÁ ÇÎÊíÇÑ ÇÓã ÇáÚãíá")
A5.Text = ""
Else
With Me
If Me.A5.Text > Me.A1.Text = True Then
MsgBox "هذه الرساله عند تشغيل الكود تظهر مرتين ورا بعض اريدها تظهر مره واحده فقط"
A5.Text = ""
Else
End If: End With
If ComboBox2.Text = "ÈÇáßÑÊæäÉ" Or ComboBox2.Text = "ÈÇáÚáÈÉ" Or ComboBox2.Text = "ÈÇáÚÈæÉ" = True Then
ws.Cells(3, 2).Value = ""
ws.Cells(3, 1).Value = Me.A5.Value
Else
If ComboBox2.Text = "ÈÇáÞØÚÉ" Or ComboBox2.Text = "ÈÇáãÊÑ" Or ComboBox2.Text = "ÈÇáßíáæ" Or ComboBox2.Text = "ÈÇáÚÏÏ" = True Then
ws.Cells(3, 1).Value = ""
ws.Cells(3, 2).Value = Me.A5.Value
End If
End If
End If
End Sub

 

[عبدالسلام ابوالعوافي]

اضف

Exit Sub

بعد

A5.Text = ""

 

[ابو حمادة]

شكرا استاذ  عبدالسلام ابوالعوافي لاهتمامك

بس ممكن اعرف اضفها فين بعد اذنك

انا بضفها بتعمل خطأ في تطبيق الكود

 

[عبدالسلام ابوالعوافي]

ضفها بعد الصف السادس 

[ابو حمادة]

ممكن حضرتك تضفها في الكود وتبعت الكود كامل بعد اذنك انا حولت فيه كتير وبردو الرساله تظهر مرتين

[عبدالسلام ابوالعوافي]

لو ترفع الملف يكون افضل .. يمكن تكون الاشكالية في كود اخر

[ياسر العربى]

اخي الكريم أبو حمادة يرجى التسهيل على الاخوة  الكرام حتى يتثنى لهم مساعدتك ام انك لا تريد ؟؟؟؟

ارفق الملف واذا كان به اي شئ مهم احذفه وارفق الجزء الخاص بالمشكلة فقط

اخي الكريم عبد السلام 

مجهود رائع داخل المنتدى جزاك الله خير

تقبلوا فائق احترامي

[ابو حمادة]

هذا الملف المرفق به الكود المطلوب

Book1.rar

[ياسر العربى]

تفضل اخي الكريم

المشكلة تكمن في الحدث للتكست بوكس حيث انه عند كتابة اي شي يتم تنفيذه

وتم تغيير الحدث من

Private Sub A4_Change()

End Sub

 

الى

Private Sub A4_AfterUpdate()

End Sub

اي بعد ملئ التكست بوكس يتم تنفيذ الكود

 

Book1.rar

 

[ابو حمادة]

شكرا استاذ ياسر ولكن الامر بالطريقه دي لا يعمل غير لو تم الضغط بالماوس في اي مكان خارج التكست وانا اريد يتم تطبيق الكود عند كتابة الرقم وهذه الطريقه للاسف لا تفي بالغرض المطلوب جرب بنفسك الملف الاصلي وجرب هذا الملف بعد التعديل وانت شاهد الفرق في التطبيق

 

[ابو حمادة]

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

 

[ياسر العربى]

تفضل جرب المرفق

Book1.rar

[ابو حمادة]

تمام كدا اساذ ياسر

ولي استفسار بالنسبة للرساله التي تفي بان القيمة اكبر هل من الممكن ان يتم كتابة الرقم الموجود في الJكست بوكس (A1 ) 

بمعني لو فرض ان الرقم المكتوب في A1          

=10

 تظهر الرساله بنفس النص  ( عفوا هذا العدد اكبر من القيمة الموجودة ( القيمة الموجودة هي 10 )

[ياسر العربى]

تفضل الملطوب

 

 

Book1.rar

[عبدالسلام ابوالعوافي]

Private Sub A4_Change()
    Dim ws As Worksheet
    Set ws = Worksheets("Archives_Bill")
    If ComboBox2.Text = "" And A4.Text <> "" Then
            MsgBox ("الرجاء اختيار الوحدة")
            A4.Text = ""
            Exit Sub
    Else
            With Me
                If Me.A4.Text > Me.A1.Text = True Then
                    MsgBox "عفوا هذا العدد اكبر من القيمة الموجودة"
                    ' تظهر هذه الرساله ومعها القيمة الموجوده او الفرق بنهم الموجود في ( A1 )
                    A4.Text = ""
                Else
            End If: End With
        If ComboBox2.Text = "بالكرتونة" Or ComboBox2.Text = "بالعلبة" Or ComboBox2.Text = "بالعبوة" = True Then
            ws.Cells(3, 2).Value = ""
            ws.Cells(3, 1).Value = Me.A4.Value
        Else
        ' Exit Sub
                If ComboBox2.Text = "بالقطعة" Or ComboBox2.Text = "بالمتر" Or ComboBox2.Text = "بالكيلو" Or ComboBox2.Text = "بالعدد" Or ComboBox2.Text = "بالطن" = True Then
                    ws.Cells(3, 1).Value = ""
                    ws.Cells(3, 2).Value = Me.A4.Value
                End If
        End If
    End If
End Sub

 

[ابو حمادة]

شكر ا جزيلا استاذ ياسر العربي والاستاذ عبد السلام لاهتتمامكم بالموضوع 

لكم مني جزيل الشكر والتقدير والاحترام

هذا هو المطلوب

 

منذ ساعه, ياسر العربى said:

تفضل الملطوب

 

 

Book1.rar

تسلم ياغالي كدا تمام التمام

 

لو امكن اساتذتي الكرام هناك ملف اخر اريد تعديله 

ان امكن 

[ياسر العربى]

يرجى عمل موضوع جديد

بالمطلوب في الملف الجديد

تقبل تحياتي

[ابو حمادة]

2 دقائق مضت, ياسر العربى said:

يرجى عمل موضوع جديد

بالمطلوب في الملف الجديد

تقبل تحياتي

هذا رابط للملف اخي الكريم لو تكرمت

القي نظرة عليه ويريت تعرفني ممكن يتعمل المطلوب ولا صعب 

علما ان الكود يعمل جيدا ولكن اريد ان اضيف بالكود سطر يستبعد الصفوف الملونه باللون الاخضر اسفل كل صفحة 

حيث ان هذه الصفوف بها دوال خاصه بالجمع والتوقيعات 

http://www.officena.net/ib/messenger/16454/#comment-38214

اي توضيح انا موجود

 

[ابو حمادة]

الملف وصل استاذ ياسر العربي ؟

ارجو الرد

 

[ياسر العربى]

اخي الكريم هذا ليس رابط الملف دا رابط رسالة عندك ضع الرابط الصحيح

[ابو حمادة]

3 دقائق مضت, ياسر العربى said:

اخي الكريم هذا ليس رابط الملف دا رابط رسالة عندك ضع الرابط الصحيح

تعديل لاستدعاء البيانات.rar

[ياسر العربى]

يعني انت محتاج بيانات الشيت الاول تترحل للشيت التاني مع ترك 3صفوف بعد كل 25 صف 

ممكن يامعلم 

بس انت كدا دخلت مواضيع في بعضها ومسمعتش الكلام وعملت موضوع جديد

المهم انا هحاول اظبطلك طلبك عند تفرغي اذا كان حسب ما فهمت

تقبل تحياتي

[ابو حمادة]

بالظبط اخي الكريم دا هو المطلوب مع العلم ان الصفوف التي تخص التوقيعات الملونه باللون الاخضر بها دوال المفروض مش تتمسح 

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

بالنسبه للملف ال شغال فيه حاليا 

فيه مشكله وجهتني بخصوص الملف الاول 

يريت تطلع عليه تاني وتشوف الخا دا علاجه ايه

الخطأ في السطر دا 

If Me.A4.Text > Me.A1.Text = True Then
 

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

Book1.rar

[ابو حمادة]

؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

السلام عليكم

[ابو حمادة]

في ١٩‏/٥‏/٢٠١٦ at 12:40, ياسر العربى said:

تفضل جرب المرفق

Book1.rar

Private Sub G3_Change()
Dim Ws As Worksheet
Set Ws = Worksheets("Bill")
If G3 <> "" And G3.MatchFound = False Then MsgBox "  ÝÖáÇ ÇÎÊÑ ãä ÇáÞÇÆãå", vbCritical, "ÎØÃ": G3 = "": Exit Sub
With Me
عند ظهور هذه الرسالة تظهر مرتين ورا بعض 
If .CheckBox2.Value = False And .CheckBox3.Value = False Then MsgBox ("  من فضلك أختر قبل الاختيار"), vbCritical, "ÎØÃ": G3 = "": Exit Sub

Ws.Cells(3, 7).Value = Me.G3.Value
H3 = Ws.Range("T3").Text ' ÇáÞÓã
I3 = Ws.Range("U3").Text ' ÇÓã ÇáÕäÝ
U3 = Ws.Range("X3").Text ' ÇáÑÕíÏ ÈÇáãÎÒä
Y3 = Ws.Range("Y3").Text ' ÓÚÑ ÇáÔÑÇÁ
If CheckBox2.Value = True Then
Ws.Range("B3").Value = "ÔÑÇÁ"
End If
If CheckBox3.Value = True Then
Ws.Range("B3").Value = "ÈíÚ"
End If: End With
End Sub

ارجو من الاخوة الكرام تصحيح هذا الكود حيث ان هذه الرسالة 

If .CheckBox2.Value = False And .CheckBox3.Value = False Then MsgBox ("  من فضلك أختر قبل الاختيار "), vbCritical, "ÎØÃ": G3 = "": Exit Sub

عند ظهورها تظهر مرتين ورا بعض بدون داعي ارجو معرفة السبب وتصحيح الكود وجزاكم الله خيرا

 

 

هذا ملف مرفق اتمني العمل عليه

Book2.rar

 

تم تعديل مايو 24, 2016 بواسطه ابو حمادة