الجموعي

لدي تحفظ استاءنا الكبير ابو إبراهيم الغامدي على تجميع البيانات بطريقة أفقية لنفترض أنا منحة إضافية لموظف ما أعطيت في نفس الشهر وبسجل جديد في هذه الحالة لا تصلح طريقة التجميع الأفقي لأنه سيتم حساب سجلين للموظف في الاستعلام وهنا التجميع يتم ويكون خاطئ اي يتم تجميع كل سطر لوحده

تعقيب بعد إذن الاستاذ أبو إبراهيم الغامدي ظهور حقل في الاستعلام ليس بالضرورة ظهورة في التقرير هدف ظهور الحقل في الاستعلام الترتيب ليس إلا في التقرير انت من يحدد الحقول المراد ظهورها

الخطأ كان على مستوى الجزئية التالية [ImagePath2].Picture = [ImagePath2] ' هنا الخطأ [ImageFrame2].Picture = [ImagePath2] ' التصحيح

تفضل أستاذ في المثال دالتان معرفتان الدالة الأولى لتفقيط الوقت الدالة الثانية لتفقيط مجموع الوقت دالة تفقيط الوقت.xls

إليك الدالة المعرفة TimeToLettre الدالة تعمل إلى غاية "99:99:99" وتعمل للساعات فقط أو الدقائق فقط أو الثواني فقط Function TimeToLettre(Time As Variant) As String ' Created By Benkhalifa Djemoui ' Algeria: 05-12-2020 Dim MyHour As Variant Dim MyMinute As Variant Dim MM, HH, SS As String Dim H, M, S As Byte '=============================================================================================================================== MyHour = Array("", "ساعة", "ساعتان") '=============================================================================================================================== MyMinute = Array("صفر", "دقيقة", "دقيقتان", "ثلاث", "أربع", "خمس", "ست", "سبع", "ثمان", "تسع", _ "عشر", "إحدى عشر", "إثنى عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر", _ "عشرون", "واحد و عشرون", "إثنان و عشرون", "ثلاثة و عشرون", "أربعة و عشرون", "خمسة و عشرون", "ستة و عشرون", _ "سبعة و عشرون", "ثمانية و عشرون", "تسعة عشرون", _ "ثلاثون", "واحد و ثلاثون", "إثنان و ثلاثون", "ثلاثة و ثلاثون", "أربعة و ثلاثون", _ "خمسة و ثلاثون", "ستة و ثلاثون", "سبعة و ثلاثون", "ثمانية و ثلاثون", "تسعة و ثلاثون", _ "أربعون", "واحد و أربعون", "إثنان و أربعون", "ثلاثة و أربعون", "أربعة و أربعون", "خمسة و أربعون", "ستة و أربعون", _ "سبعة و أربعون", "ثمانية و أربعون", "تسعة و أربعون", _ "خمسون", "واحد و خمسون", "إثنان و خمسون", "ثلاثة و خمسون", "أربعة و خمسون", _ "خمسة و خمسون", "ستة و خمسون", "سبعة و خمسون", "ثمانية و خمسون", "تسعة و خمسون", _ "ستون", "واحد و ستون", "إثنان و ستون", "ثلاثة و ستون", "أربعة و ستون", _ "خمسة و ستون", "ستة و ستون", "سبعة و ستون", "ثمانية و ستون", "تسعة و ستون", _ "سبعون", "واحد و سبعون", "إثنان و سبعون", "ثلاثة و سبعون", "أربعة و سبعون", _ "خمسة و سبعون", "ستة و سبعون", "سبعة و سبعون", "ثمانية و سبعون", "تسعة و سبعون", _ "ثمانون", "واحد و ثمانون", "إثنان و ثمانون", "ثلاثة و ثمانون", "أربعة و ثمانون", _ "خمسة و ثمانون", "ستة و ثمانون", "سبعة و ثمانون", "ثمانية و ثمانون", "تسعة و ثمانون", _ "تسعون", "واحد و تسعون", "إثنان و تسعون", "ثلاثة و تسعون", "أربعة و تسعون", _ "خمسة و تسعون", "ستة و تسعون", "سبعة و تسعون", "ثمانية و تسعون", "تسعة و تسعون") '=============================================================================================================================== Time = Split(Time, ":") H = Int(Time(0)) M = Int(Time(1)) S = Int(Time(2)) '=============================================================================================================================== If H = 0 Then GoTo Minute Select Case H Case 1 To 2: Select Case M: Case 0: HH = MyHour(H): Case Else: HH = MyHour(H) & " و ": End Select Case 3 To 10: Select Case M: Case 0: HH = MyMinute(H) & " ساعات ": Case Else: HH = MyMinute(H) & " ساعات و": End Select Case 11 To 99: Select Case M: Case 0: HH = MyMinute(H) & " ساعة ": Case Else: HH = MyMinute(H) & " ساعة و ": End Select End Select '=============================================================================================================================== Minute: If M = 0 Then GoTo Second If M <> 15 And M <> 30 Then Select Case M Case 1: Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select Case 2: Select Case S: Case 0: MM = MyMinute(M): Case Else: MM = MyMinute(M) & " و": End Select Case 3 To 10: Select Case S: Case 0: MM = MyMinute(M) & " دقائق ": Case Else: MM = MyMinute(M) & " دقائق و ": End Select Case 11 To 59: Select Case S: Case 0: MM = MyMinute(M) & " دقيقة ": Case Else: MM = MyMinute(M) & " دقيقة و ": End Select End Select '=============================================================================================================================== Else If H <> 0 Then Select Case M Case 15: Select Case S: Case 0: MM = " ربع ": Case Else: MM = " ربع و ": End Select Case 30: Select Case S: Case 0: MM = " نصف ": Case Else: MM = " نصف و ": End Select End Select Else Select Case M Case 15: Select Case S: Case 0: MM = " ربع ساعة ": Case Else: MM = " ربع و ": End Select Case 30: Select Case S: Case 0: MM = " نصف ساعة ": Case Else: MM = " نصف و ": End Select End Select End If End If '=============================================================================================================================== Second: If H <> 0 Or M <> 0 Then Select Case S Case 1: Select Case M: Case 0: SS = " و ثانية": Case Else: SS = " ثانية": End Select Case 2: Select Case M: Case 0: SS = " و ثانيتان": Case Else: SS = " ثانيتان": End Select Case 3 To 10: Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثوان": Case Else: SS = MyMinute(S) & " ثوان": End Select Case 11 To 59: Select Case M: Case 0: SS = " و " & MyMinute(S) & " ثانية": Case Else: SS = MyMinute(S) & " ثانية": End Select End Select '=============================================================================================================================== Else Select Case S Case 1: SS = "ثانية" Case 2: SS = "ثانيتان" Case 3 To 10: SS = MyMinute(S) & " ثوان" Case 4 To 59: SS = MyMinute(S) & " ثانية" End Select End If '=============================================================================================================================== TimeToLettre = Trim(HH) & " " & Trim(MM) & " " & Trim(SS) '=============================================================================================================================== Erase MyHour, MyMinute End Function

شاهد المرفق لعله المطلوب تصفية1.rar

معذرة اخي عن الإطالة بسبب ظروف الشغل تفضل اخي لعله المطلوب مساعدة فى اليوزر فورم.rar

تفضل لعله المطلوب مواضيع معدل.rar مواضيع معدل.rar

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

تم المطلوب تم إرجاع نطاق البحث من النطاق A2 إلى أخر النطاق الذي به البيانات لانه لو تم تحديد بيانات البحث البيانات الي قبل النطاق 7 وبعد 27 لن تظهر لك في عملية البحث وبذلك لن تستطيع التعديل او حذفها تم التعديل على زر التعديل والحذف ليتماشى مع ما طلبته مواضيع معدل.rar بقي زر الإضافة راح أحاول في الكود

بالسبة لتحديد نطاق البحث في حدث تكست البحث قم بتعديل السطر 8 بهذا الكود For Each c In Range("B7:B26") ليصبح على النحو التالي Private Sub TextBox4_Change() TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" ListBox1.Clear Sheets(1).Activate ListBox1.Clear k = 0 For Each c In Range("B7:B26") B = InStr(c, TextBox4) If B > 0 Then ListBox1.AddItem ListBox1.List(k, 0) = Cells(c.Row, 2).Value ListBox1.List(k, 1) = Cells(c.Row, 1).Value ListBox1.List(k, 2) = Cells(c.Row, 3).Value k = k + 1 End If Next c End Sub اما بخصوص اضافة اسم لم افهم جيدا هل تريد الاضافة قبل السطر 26

تفضل لعله المطلوب تم التعديل على البحث تم التعديل على زر تعديل تم اضافة زر حذف مواضيع معدل.rar

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

للأسف التاريخ خاطئ من تنسيق المصدر في انتظار الخبراء لمساعتك

هل تقصد هذا التنسيق Bank.rar

أقصد ملف التكست Txt الذي قمت باستداء البيانات منه

أرفق لي الملف الأصلي للعمل عليه

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

أخي الكريم أعتقد أن المشكلة من جهازك نفس التنسيق الذي ذكرته ظهر عندي

ماشاء الله بارك الله فيك أستاذي بالنسبة - في خلية رقم H9 في حالة لو وجد رقم بعد العلامة العشرية سوف يقربها الي اكبر مثال في الملف في الخلية H9 يوجد رقم 5.29 اذن عدد الاسطر هي 6 بعد التقريب و ليس 5 إذا كات الفاصلة خمسين فما فوق بالتقريت 6 وادا اقل بالتقريب 5

في حدث ThisWorkbook ضع هذا الكود Private Sub Workbook_Open() Dim ws As Worksheet Set ws = Sheets("إسم الورقة المراد حمايتها") With ws .Protect Password:="هنا كلمة المرور", DrawingObjects:=True, Contents:=True, Scenarios:=True .EnableSelection = xlNoSelection End With End Sub

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

Dim x As String x = TextBox2 x.Text = "أكتب رقم جديد" Range("A2").Select Range("A1:F20").Select Selection.copy Sheets.Add.Name = x Range("A1:F20").Select ActiveSheet.Paste Application.cutcopymod.false

وعليكم السلام ورحمة الله تعالى وبركاته فعلا هو المطلوب بارك الله فيك لي طلب بسيط تحويل رقم التكرار الى رمز مثلا 5 تكتب في العلامات ///// وهكذا

تفضل عن طريق الدالة لعله المطلوب فصل الكلام عن الأرقام.rar