أبو حنــــين

عمل رائع أخي عبد الله زادك الله علما على علم

اعدادات اللغة لديك غير صحيحة من لوحة التحكم ثم اعدادات اقليمية غير لغة الادخال الى العربية و الله اعلم

المشكلة بسيطة اخي ملاحظة : الخلية F21 كانت تحتوي على مسافة و هي غير مرئية طبعا يجب الدخول للخلية و مسحها اكتب في الخلية D21 المعادلة التالية =IF(F21="";"";F21+365)

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

اخي اعتقد انه يجب تغيير الاعداد 5000 في الكود التالي بما يناسبك If Sheet2.Range("d4").Text = "صرف" Then '--------------------------- Sheet2.Range("f5") = Application.WorksheetFunction.VLookup(Sheet2.Range("i4"), Sheet1.Range("r5:t5000"), 2, 0) Sheet2.Range("i5") = Application.WorksheetFunction.VLookup(Sheet2.Range("i4"), Sheet1.Range("r5:t5000"), 3, 0) End If If Sheet2.Range("d4").Text = "ادخال" Then '--------------------------- Sheet2.Range("fg5") = Application.WorksheetFunction.VLookup(Sheet2.Range("i4"), Sheet1.Range("u5:w5000"), 2, 0) Sheet2.Range("i5") = Application.WorksheetFunction.VLookup(Sheet2.Range("i4"), Sheet1.Range("u5:w5000"), 3, 0) End If End If و هذا الجزئ من الكود موجود في الماكرو المسمئ Sub recall1() و الله اعلم

الشرح شرح.rar

وهذا تعديل يبين آخر مستخدم باليوم و الساعة ملاحظة : يجب حفظ الملف قبل الخروج من البرنامج نموذج دخول بصلاحيات اوراق العمل 2.rar

هل تقصد هكذا أخي الحبيب : / دغيدي نموذج دخول بصلاحيات اوراق العمل 2.rar

اخي الدغيد انظر الرابط http://www.officena.net/ib/index.php?showtopic=43153

هل قصدت هكذا 1.rar

و هذه محاولة اخرى تلبية لطلب اخي الحبيب الدغيدي و اعتذر للتأخير لظروف العمل كلمة المرور.rar

المرفق تسلسل2.rar

نعم يمكن ذلك Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then s = 0 For t = 1 To 500 If Cells(t, 2) > "" Then s = s + 1 Cells(t, 2).Offset(0, -1).Value = s End If Next End If End Sub

جرب الطريقة التالية تسلسل.rar

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

السلام عليكم جرب المرفق *********************************************** المرفق الثاني يحتوي على تعديل بسيط و عو زر الذهاب للفورم فقط بيانات محلات ريحانة.rar بيانات محلات 2ريحانة.rar

العفو اخي

هذه محاولة تتطلب التعديل انشاء تقرير متقدم.rar

هذه محاولة مساعدة في فورم ادخال وترحيل .rar

جرب هذه المعادلة =IF(C3<=35;C3*0.86;C3*1)

تستطيع استعمال الكود التالي Private Sub CommandButton1_Click() Range("G1") = Application.WorksheetFunction.Max(Range("C:C")) End Sub Private Sub CommandButton2_Click() Range("G2") = Application.WorksheetFunction.Min(Range("C:C")) End Sub أو استعمال الكود التالي Private Sub CommandButton3_Click() Calendar = vbCalHijri TextBox1 = Application.WorksheetFunction.Max(Range("C:C")) TextBox2 = Application.WorksheetFunction.Min(Range("C:C")) TextBox1 = Format(TextBox1, "yyyy-mm-dd") TextBox2 = Format(TextBox2, "yyyy-mm-dd") End Sub

قمت بعمل محاولة حسب فهمي للموضوع فورم أستدعاء وبحث وإدخال.rar

عمل ممتاز و متعوب عليه و الأكيد أنه تطلب وقتا و جهدا كبيرين بارك الله فيك أخي هيثم و زادك علما

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

يمكنك عمل التالي Private Sub CommandButton1_Click() Dim Response If TextBox1 = "" Or TextBox2 = "" Or TextBox3 = "" Then MsgBox "íÌÈ ÊÚÈÆÉ ßÇÝÉ ÇáÍÞæá", vbExclamation, "ÍÞæá ÛíÑ ããÊáÆÉ" Else Response = MsgBox(":áÞÏ ÞãÊ ÈÅÏÎÇá ÇáÈíÇäÇÊ ÇáÊÇáíÉ" & vbNewLine & "" & vbNewLine & "ÇáÅÓã: " & TextBox1 _ & vbNewLine & "" & vbNewLine & "ÇáÚãÑ: " & TextBox2 & vbNewLine & "" & vbNewLine & "ÇáãÓãì ÇáæÙíÝí: " & TextBox3 & vbNewLine & "" _ & vbNewLine & "Ýåá ÊæÏ ÇáÅÓÊãÑÇÑ¿", vbYesNo + vbQuestion, "ÊÃßíÏ ÇáÅÏÎÇá") If Response = vbYes Then With Columns(1).Rows(65536).End(xlUp) .Offset(1, 0) = TextBox1 .Offset(1, 1) = TextBox2 .Offset(1, 2) = TextBox3 End With Me.Hide MsgBox "ÊãÊ ÅÖÇÝÉ ÌãíÚ ÇáÈíÇäÇÊ ÈäÌÇÍ", vbInformation, "ÊãÊ ÇáÅÖÇÝÉ" End If End If '*************************************** Sheet2.Range("C5") = TextBox2.Text '*************************************** End Sub Private Sub UserForm_Initialize() TextBox1.Value = Format(Now(), "yyyy/mm/dd") End Sub