عبدالله المجرب

عزيزي راعي الرحل
هل هذا ما تقصده
مفيد برنامج الجداول المدرسية.rar

السلام عليكم
بعد اذن الغالي ابو نصار
هل تقصد هذه
http://www.officena.net/ib/index.php?showtopic=13997&st=0&p=60720&#entry60720

السلام عليكم
جرب المرفق (اكتشف التعديل الذي تم)
New Microsoft Excel Worksheet.rar

تفضل المرفق
تم عمل الطلبين
تامينا ت2012 (1).rar

اخي الفاضل لماذا تكرار الموضوع
على العموم تفضل المرفق
تم استخدام الدالة SUMPRODUCT
ابواحمد
ولد المجرب.rar

شاهد المرفق في هذه المشاركة 
 
 
 
تم ارفاق الملف للفائدة
 
 
inputbox with password mask.xls
 
 

راجع هذا الموضوع وان شاء الله تجد ما تريد
 
 

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

شاهد التعديل 
ان شاء الله يكون المطلوب
 
المصنف1.rar

تفضل المرفق
 
 
تصفية متقدمة.rar

السلام عليكم 
قمت بإزالة مربعات النص وإستبدالها بخلايا الاكسل من المدى A2:F2
 
أصبح الكود كالتالي 
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A2:F2]) Is Nothing Then If Target = "" Then AutoFilterMode = False Else Range("RN").AutoFilter , field:=Target.Column, Criteria1:=Target End If End If End Sub هذا الكود يفيد لجميع خلايا المدى
جرب المرفق 
اضافة وتغيير في صيغة البحث 2010.zip

السلام عليكم 
تفضل أخي الكريم 
إن شاء الله يكون هذا هو المطلوب
 
 
6.zip

السلام عليكم 
جرب الأتي 
 
إستبدل المعادلة التي في نص 2 في التقرير بهذه
=ArbNum2Text(Val([Total]);2;3;"درجـة";"درجات";1;"جزء";"أجزاء";1)

السلام عليكم 
 
اخي الفاضل اليك الملف المرفق
 
في الملف ستجد زر سيقوم بإظهار رقم الفلاشة 
 
هذا الرقم تكتبه في حدث ThisWorkbook
 
في هذا السطر 
'If xxx = "رقم الفلاشه ضعه هنا" Then ثم تقوم بإزالة الفاصلة الموجودة في بداية هذه الاسطر 
'If xxx = "رقم الفلاشه ضعه هنا" Then 'MsgBox " hi" 'Else 'MsgBox "الرقم التسلسلي غير مطابق" 'Application.Quit 'End If ثم تحفظ ما قمت به بعد ذلك افتح الملف 
 
اذا كانت الفلاشة مختلفة لن يعمل الملف لعدم تطابق الرقم التسلسلي 
 
وشكراً 
الفلاشة.zip

اعتقد أنه بعد تفعيل الكود لا يمكن عمل تراجع والحل الوحيل لو حصل خطاء هو إغلاق المصنف دون حفظ
والله أعلم

جرب المرفق
 
Abu_Ahmed.zip

تفضل المرفق 
جرب وضع الرقم 111 في ختنة البحث أو الرقم 222
tajreeb.rar

السلام عليكم تم إضافة هذا الكود في الزر المسمى (كود لنسخ جميع بيانات موقع الذي تم إدخالة ولسنة مالية محددة)
Private Sub أمر8_Click() On Error Resume Next Dim MyAr As Variant, I As Integer, Z As Integer MyAr = Array("يناير", "فبراير", "مارس", "إبريل", "مايو", "يونيو", "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") Set db = CurrentDb() sql = "select * from Actions " Set rs = db.OpenRecordset(sql, dbOpenDynaset) For I = 1 To DCount("[NamesHospitals]", "Hospitals") For Z = 1 To 12 rs.AddNew rs("BillTaype") = "رواتب عمالة ومستهلكات" rs("Date1") = Year(Date) rs("Month1") = MyAr(Z - 1) rs("Status") = "لم يصل" rs("idhospitals") = I rs.Update Next Next rs.Close MsgBox "تم التحديث" End Sub جرب المرفق بعد التعديل 
1111.rar

السلام عليكم 
 
 
إستبدل هذا السطر في الكود 
Mail.TextBody = "RENT EXPIRED FOR MR" & " " & .Cells(i, 1).Text & " " & "ON DATE" & " " & .Cells(i, 6).Text & " " & "AFTER" & " " & .Cells(i, 7).Text & " DAYS" & " " & "AMOUNT IS" & " " & .Cells(i, 3).Text بهذا
Mail.TextBody = "RENT EXPIRED FOR MR" & " " & .Cells(i, 1).Text & " " & "ON DATE" & " " & .Cells(i, 6).Text & " " & "AFTER" & " " & .Cells(i, 7).Text & " DAYS" & vbNewLine & " " & "AMOUNT IS" & " " & .Cells(i, 3).Text

السلام عليكم 
اليك المرفق 
 
db5.rar

الكود سيصبح هكذا 
Private Sub Workbook_Open() Dim MyFlName As String MyFlName = "TEST-1.xls" If ThisWorkbook.Name <> MyFlName Then Application.DisplayAlerts = False ThisWorkbook.Close End If End Sub وهنا يتم تعديل اسم الملف 
MyFlName = "TEST-1.xls"

اليك هذه الروابط
 
http://www.officena.net/ib/index.php?showtopic=51013
 
http://www.officena.net/ib/index.php?showtopic=150
 
http://www.officena.net/ib/index.php?showtopic=15722&amp;hl=
 
http://www.officena.net/ib/index.php?showtopic=40690
 
وهناك المزيد بس انت اكتب في خانة  البحث (الجداول المحورية) وستجد ما يسرك

السلام عليكم 
اليك الملف بعد التعديل
 
2560.rar

السلام عليكم 
تم إضافة كود في حدث التغيير لورقة العمل 
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [C2:C10]) Is Nothing Then If Target = Target.Offset(0, -1) Then MsgBox " قسم مكرر يرجى التغيير": Target = "" End If End Sub اليك المرفق 
 
ملف.rar

السلام عليكم 
إستبدل كود زر الحفظ في البورم بهذا
Private Sub CommandButton1_Click() Dim iRow As Long, Cl As Range, Abu_Ahmed As Boolean Dim ws As Worksheet T = [B10000].End(xlUp).Row Set ws = Worksheets("ورقة1") iRow = ws.Cells(Rows.Count, 2) _ .End(xlUp).Offset(1, 0).Row '================================================================================== For Each Cl In Range("B2:B" & [B10000].End(xlUp).Row) If Cl = Me.TextBox2.Value Then If Cl.Offset(0, 1) = Me.TextBox3.Value And Cl.Offset(0, 2) = Me.TextBox4.Value And _ Cl.Offset(0, 3) = Val(Me.TextBox5.Value) Then Abu_Ahmed = True: GoTo 1 End If Next 1 If Abu_Ahmed Then MsgBox "البيانات موجودة مسبقاً": GoTo 2 Else ws.Cells(iRow, 2).Value = Me.TextBox2.Value ws.Cells(iRow, 3).Value = Me.TextBox3.Value ws.Cells(iRow, 4).Value = Me.TextBox4.Value ws.Cells(iRow, 5).Value = Me.TextBox5.Value End If '===================================================================================== Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox2.SetFocus 2 End Sub