احمد عبد الناصر

السلام عليكم جرب هذه =IF(OR(S11="";S11="غ");"غ";IF(INT(S11*0.4)=S11*0.4;S11*0.4;IF(ROUND(S11*0.4-INT(S11*0.4);1)>0.5;ROUND(S11*0.4;0);INT(S11*0.4)+0.5))) تحياتي

السلام عليكم جرب هذا تحياتي cont+.rar

السلام عليكم هذا كود للاستدعاء من ملف الاكسيس Dim rsData As ADODB.Recordset Dim sConnect As String Dim sSQL As String sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & اسم_ملف_الاكسيس & ".mdb;Persist Security Info=True " sSQL = "select * from اسم_الجدول" Set rsData = New ADODB.Recordset rsData.Open sSQL, sConnect, adOpenForwardOnly, _ adLockReadOnly, adCmdText If Not rsData.EOF Then 'الخلية المراد جلب البيانات اليها [a1].CopyFromRecordset rsData End If و هذا للاضافة الي ملف الاكسيس Dim rsData As ADODB.Recordset Dim sConnect As String Dim sSQL As String sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ActiveWorkbook.Path & "\" & اسم_ملف_الاكسيس & ".mdb;Persist Security Info=True " 'تحدد اسماء حقول الجدول لملف الاكسيس و الخلاية التي تحتوي القيم المراد اضافتها sSQL = "insert into اسم_الجدول (field1,field2,field3) values (" & [b1] & "," & [b2] & "," & [b3] & ")" Set rsData = New ADODB.Recordset rsData.Open sSQL, sConnect, adOpenForwardOnly, _ adLockReadOnly, adCmdText ملاحظة فعل هذه tools > references >microsoft activex data objects 2.6 library تحياتي

السلام عليكم المحتوي يظهر بمجرد الوقوف علي الخلية . جرب المرفق قائمة باسماء الصفحات++.rar

السلام عليكم جرب هذا تحياتي قائمة باسماء الصفحات+.rar

السلام عليكم 1 يكتب 10000 101 يكتب 10100 10101 يكتب 10101 102 يكتب 10200 لتوحيد الخانات تحياتي

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

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

السلام عليكم جرب هذا تحياتي nta1+.rar

السلام عليكم استاذ ضاحي تحياتي لك و مبروك علي الترقية و من تقدم الي تقدم

استاذ عمرو لي ملاحظة و تساؤل الملاحظة لو تم عرض الكمية بنفس طريقة عرض القيمة سواء في الادخال او التقارير 1,000,000.00 التساؤل : خانة الضريبة غير موجودة في الفواتير هل هذا مقصود ؟

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

السلام عليكم ان كنت تقصد *1 , اعتقد انها تستخدم لتحويل النص الي رقم لكن لا اظن ان لها فائدة هنا لكني احببت عدم التعديل علي الكود فكاتبه ادرى به , و الله اعلم عامتا هذا السطر يعطي المتغير x قيمة التكست بوكس المسمى textbox02 ليقوم باقي الكود بالبحث عنه و تعديل باقي السطر بدلالته . المشكلة انها كانت مكتوبة textbox1 وهو التكست بوكس الخاص بالبحث اما textbox02 فيحتوي علي القيمة للسطر المختار . تحياتي

السلام عليكم استبدله بهذا Private Sub CommandButton1_Click() Application.ScreenUpdating = True YesNoCancel = MsgBox("ãåáÇ åá ÞãÊ ÈÇÏÎÇá ÊÇÑíÎ ÊÞÏíã ÇáÇÓÊãÇÑå Ýì ÔíÊ ÇáÈíÇäÇÊ . ¿", vbYesNoCancel + vbCritical, "ÇÈÑÇåíã ãÍãÏ ---------------------------------- ãä ÝÖáß ... ÇäÊÈå ") Select Case YesNoCancel Case vbYes If TextBox1.Text = "" Then MsgBox "íÌÈ Úáíß ÇÎÊíÇÑ ÇáÑÞã ÃæáÇ ", vbInformation, "ÎØÃ" TextBox1.SetFocus Exit Sub Else Dim x, R As Variant x = TextBox02.Value * 1 R = WorksheetFunction.Match(x, Range("NO"), 0) + 7 Sheet1.Cells(R, "B").Value = TextBox3.Value Sheet1.Cells(R, "C").Value = TextBox4.Value 'Sheet1.Cells(R, "E").Value = TextBox7.Value 'Sheet1.Cells(R, "E").Value = CDate(Me.TextBox7) Sheet1.Cells(R, "D").Value = TextBox5.Value Sheet1.Cells(R, "E").Value = TextBox6.Value Sheet1.Cells(R, "F").Value = TextBox7.Value Sheet1.Cells(R, "G").Value = TextBox8.Value Sheet1.Cells(R, "H").Value = TextBox9.Value Sheet1.Cells(R, "I").Value = TextBox10.Value Sheet1.Cells(R, "J").Value = TextBox11.Value Sheet1.Cells(R, "K").Value = TextBox12.Value Sheet1.Cells(R, "L").Value = TextBox13.Value Sheet1.Cells(R, "M").Value = TextBox14.Value Sheet1.Cells(R, "N").Value = TextBox15.Value Sheet1.Cells(R, "O").Value = TextBox16.Value Sheet1.Cells(R, "P").Value = TextBox17.Value Sheet1.Cells(R, "Q").Value = TextBox18.Value Sheet1.Cells(R, "R").Value = TextBox19.Value Sheet1.Cells(R, "S").Value = TextBox20.Value Sheet1.Cells(R, "T").Value = TextBox21.Value Sheet1.Cells(R, "U").Value = TextBox22.Value Sheet1.Cells(R, "V").Value = TextBox23.Value Sheet1.Cells(R, "AC").Value = TextBox24.Value 'Sheet1.Cells(R, "AC").Value = CDate(Me.TextBox24) 'Call CODE 'Call NUMBERD MsgBox "Êã ÇÏÎÇá ÇáÈíÇäÇÊ ÈäÌÇÍ" End If Case vbNo Exit Sub Case vbCancel Exit Sub End Select Application.ScreenUpdating = False Me.Hide End Sub الفكرة كلها في هذا السطر فقط x = TextBox02.Value * 1 تحياتي

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

السلام عليكم هذه سهله باذن الله اما بالنسبة لهذا فما رايك ان يقوم الكود بمسح البيانات من صفحة data بعد كل ترحيلة , لتلافي هذه المشكله ,هل يناسبك هذا؟

السلام عليكم جرب هذا الكود يعمل عند الضغط علي ctrl+q . تحياتي ayman+.rar

السلام عليكم جرب هذا تحياتي Choose a Date+.rar

السلام عليكم جرب هذا Sub HIMA() Application.ScreenUpdating = False Dim ws10 As Worksheet Set ws10 = Sheets("ÇáÈíÇäÇÊ") LR = ws10.Cells(Rows.Count, 3).End(xlUp).Row ws10.Range("X8:Z10000").ClearContents For i = 8 To LR ws10.Cells(i, 12) = ws10.Cells(i, 10) & ws10.Cells(i, 9) & ws10.Cells(i, 8) & ws10.Cells(i, 7) & ws10.Cells(i, 6) & ws10.Cells(i, 5) & ws10.Cells(i, 4) & ws10.Cells(i, 3) ws10.Cells(i, 12).NumberFormat = "@" Next i Application.ScreenUpdating = True End Sub او بامكانك تغير تنسيق الخلايا المراد الترحيل اليها الي text . تحياتي

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

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

السلام عليكم جرب هذا الكود Sub dahmour() Application.ScreenUpdating = False With Sheets(1) .Select .AutoFilterMode = False lastrow = Range("a" & Rows.Count).End(xlUp).Row .Range("A1:D" & lastrow).AutoFilter .Range("A1:D" & lastrow).AutoFilter Field:=4, Criteria1:="ناجح" .Range("a2:d" & lastrow).Copy Sheets(2).Range("a1") .AutoFilterMode = False End With ''''''''''''''''''''''''''''''' With Sheets(2) .Select x = 1 Do Sheets(1).Range("a1:d1").Copy .Range("a" & x & ":d" & x).Insert Shift:=xlDown x = x + 21 Rows(x & ":" & x + 3).Insert Shift:=xlDown Cells(x + 3, 3) = "=SUM(R[-24]C:R[-1]C)" x = x + 4 If IsEmpty(Cells(x, 2)) Then Exit Do Loop End With '88888888888888888888888888888888888888888888888888888888 With Sheets(1) .Select .AutoFilterMode = False lastrow = Range("a" & Rows.Count).End(xlUp).Row .Range("A1:D" & lastrow).AutoFilter .Range("A1:D" & lastrow).AutoFilter Field:=4, Criteria1:="راسب" .Range("a2:d" & lastrow).Copy Sheets(2).Range("a" & x) .AutoFilterMode = False End With ''''''''''''''''''''''''''''''' With Sheets(2) .Select r = x Do Sheets(1).Range("a1:d1").Copy .Range("a" & r & ":d" & r).Insert Shift:=xlDown r = r + 21 Rows(r & ":" & r + 3).Insert Shift:=xlDown Cells(r + 3, 3) = "=SUM(R[-24]C:R[-1]C)" r = r + 4 If IsEmpty(Cells(r, 2)) Then Exit Do Loop End With Application.CutCopyMode = False ''''''''''''''''''''''''''''''' Application.ScreenUpdating = True End Sub تحياتي

الاساتذة و الاخوة الكرام شكرا و جزاكم الله خيرا علي هذه الكلمات الطيبة تحياتي

السلام عليكم الكود يعمل معي كلاتي - اكتب اي كلمة باي لغة غير العربية . مثلا cat -كليك يمين و اختارمن traduire cette valeur auto detect -تتحول cat الي قط تحياتي

السلام عليكم الفكرة الاساسية لهذا الموضوع موجودة علي المواقع الاجنية و لكن هذه تحتوي علي فكرة جديدة و هي المرونة , بحيث تستطيع زيادة البيانات بدون الحاجة الي استخدام تسمية النطاقات . جرب المرفق لتتضح الصورة . تحياتي 2 BY1 datavalidation+.rar