نجوم المشاركات

الخطوة الاولى نظهر ملفات النظام ويهمنا الجدول MSysObjects نعمل استعلام ونحتاج الى حقلين فقط name وحقل type وفي خانة المعيار نضع الرقم -32768 لتكون جملة الاستعلام تساوي SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Type)=-32768)); ثم نعمل استعلام جديد مصدرة الاستعلام السابق او نحول الاستعلام السابق الى استعلام الحاق وتكون جملة الاستعلام تساوي INSERT INTO tblform ( nameform ) SELECT MSysObjects.Name FROM MSysObjects WHERE (((MSysObjects.Name) Not In (SELECT tblform.nameform FROM tblform;)) AND ((MSysObjects.Type)=-32768)); وهنا تجد اننا استخدمنا معيار جديد عبارة استعلام فرعي لكي يلحق فقط اسماء النماذج الجديدة حتى لا يحصل تكرار لاسماء النماذج التي سبق الحاقها وايضا ممكن الاستغناء عن استعلام الالحاق بالكود وايضا ممكن تحويل الحقل في الجدول الى مربع تحرير وسرد ونجعل مصدرة كود الاستعلام الاول الملف مرفق مثال187.accdb

السلام عليكم تفضل التعديل حسب فهمي لطلبك وبعد اذن استاذ Kanory sma v 3.rar

وعليكم السلام ورحمه الله وبركاته استخدم هذا الكود للاضافه للترحيل بعدا لتعديل عليه بما بناسب الشيت المرفق . Dim i As Byte, Last As Long, Sh As Worksheet Set Sh = Sheets("data") With Sh Last = .Cells(Rows.Count, 2).End(xlUp).Row + 1 For i = 1 To 17 .Cells(Last, i).Value = Me.Controls("Tx" & i).Value Me.Controls("Tx" & i) = "" Next End With tx1.SetFocus

سعد.xlsm

السلام عليكم و رحمة الله ضع هذا فى حدث الفورم و عدل فقط اسم الشيت و عنوان الخلية Private Sub UserForm_Initialize() Me.TextBox1.Value = Format(Sheet1.Range("A1"), ".00%") End Sub

وعليكم السلام ورحمة الله وبركاته هناك طريقتين طريقه السحب : افتح الملفين ثم من صفحه الفيجوال هيكون موجود الملفين اسحب الفورم بالماوس اللى الملف الجديد طريقه التصدير : افتح الملف الذي به الفورم ثم من صفحه الفيجوال اضغط علي الفورم المراد نقله ثم اعمل export ثم افتح الملف الذب تريد نقل الفورم به ثم من صفحه الفيجوال اعمل insert واختار الفورم الذي تم تصديره

تفضل أخي . 'Table1 حسب اسم الجدول لديك 'ID حسب اسم لديك DoCmd.SetWarnings False DoCmd.RunSQL "DELETE * FROM Table1" DoCmd.RunSQL "INSERT INTO Table1 (ID) VALUES (0)" DoCmd.RunSQL "DELETE * FROM Table1" Me.Requery Refresh

ماذا تقصد بجمع الفورم اخي ؟

السلام عليكم kkhalifa1960 وافر الشكر و التقدير على إهتمام حضرتك و مقدر مساعدتك القيمة

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

استخدم المعادلة دى =AND(C3=G3,G3=K3)

ازاى ممكن اعرف حاله الارسال من البرنامج ؟

وطريقة سريعة لتحويل الجدول المرتبط لجدول محلي .. أن تضغط بيمين الماوس على الجدول ثم تختار Convert to Local Table 🙂

استاذ خالد كل عام وحضرتك بخير البرنامج اللى معايا برنامج دسم جدا جدا من مدخلات ومخرجات ولكن فيه بعض الثغرات التى تعوق العمل اليا مثال توزيع حصتان متتاليتان البرنامج بيوزع من 80 الى 90 % حصص متتالية وبيتم التعديل يدويا فى حالة الخطأ الصغرة الثانية بيتم اختيار عدد حصص ايام الاسبوع من داخل الوحدة النماطية واريد ان يكون التحكم فى عدد الحصص اليومية من النموذج وليس من الموديول الصغرة الثالثة هو حجب او عدم تمكين احد الحصص لاحد المدرسين وطبعا برنامج استاذنا الجليل ابو خليل فيه الحل لثانيا وثالثا وبحاول تطبقهم على برنامجى ومازال الامل موجود ان اجد من يساعدنى فى الحصص المتتالية

شكرا اخي على مساعدتك لكن ليس هذا المطلوب هو يرتب تصاعديا انا اريد الترتيب حسب القائمة التي بينتها في اعلى الفورم هل من حل و قد ارفقت الملف بعد وضع الامر على الزر و سترى انه لا يرتب كما اريد sma v 1.rar

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

ليس هناك ازعاج اخي الكريم ولكن القصد حتى نصل لما تريد لاقصر الطرق .... بارك الله فيك وهذه طريقة اخرى جربها واعلمنا بالنتيجة Function FnSearch(Str As String) As String Dim Arr() As String Dim i As Long Arr = Split(Str) ' """" & txtSearch & """" For i = 0 To UBound(Arr) - 1 If Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & "'") Exit For ElseIf Nz(DLookup("LikeA", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'"), 0) <> 0 Then FnSearch = DLookup("LikeB", "KindX", "LikeA='" & Trim(Arr(i)) & " " & Trim(Arr(i + 1)) & "'") Exit For End If Next i End Function Replace&add.mdb

Insert module and paste the following code Sub Highlight_Names_In_Similar_Groups() Dim groupColors(), ws As Worksheet, sh As Worksheet, colRange As Range, cell As Range, sName As String, lr As Long, i As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(2) Set sh = ThisWorkbook.Worksheets(3) Set colRange = ws.Range("E12:N20") lr = sh.Cells(sh.Rows.Count, 3).End(xlUp).Row groupColors = RandomColors(colRange.Columns.Count, True) sh.Columns("C:F").Interior.Color = xlNone For Each cell In colRange.Cells sName = Trim(cell.Value) If sName <> Empty Then For i = 3 To lr If Trim(sh.Cells(i, 3).Value) = sName And sh.Cells(i, 3).Interior.Color <> xlNone Then sh.Cells(i, 4).Resize(, 3).Interior.Color = groupColors(cell.Column - 4) End If Next i End If Next cell Application.ScreenUpdating = True End Sub Function RandomColors(ByVal numColors As Long, Optional ByVal lightColorsOnly As Boolean = False) Dim isUnique As Boolean, i As Long, j As Long ReDim colors(1 To numColors) For i = 1 To numColors Do If lightColorsOnly Then colors(i) = RGB(Int(Rnd() * 128) + 128, Int(Rnd() * 128) + 128, Int(Rnd() * 128) + 128) Else colors(i) = RGB(Int(Rnd() * 256), Int(Rnd() * 256), Int(Rnd() * 256)) End If isUnique = True For j = 1 To i - 1 If colors(i) = colors(j) Then isUnique = False: Exit For Next j Loop Until isUnique Next i RandomColors = colors End Function Then in worksheet module of the first worksheet add this part at the end of the existing code Next c End If If Target.Address = "$C$2" Then Call Highlight_Names_In_Similar_Groups End Sub

ماشاء الله تبارك الله 🙂 عمل جميل جدا .. ويفتح آفاق وأفكار كثيرة .. 😉 الشكر لك عمي @ابوخليل والشكر موصول للأستاذ @حسونة حسين ربما يمكننا بطريقة ما تحويله إلى ملف أكسس ( وهو تخصص منتدانا ) بصفحة بحث ميسرة 🙂 .. وهل المواضيع متجددة ( تحدث نفسها ) ؟؟ 👍🏼 ✨ موضوع مميز ✨ 👍🏼 .. يثبت 📌

السلام عليكم ورحمة الله استخدم هذا الكود لاظهار اليوزرقورم بدلا من الكود الموجود لديك واذا لزم الامر غير اسم اليوزر فورم فى الكود الجديد Sub ShowUserF() UserForm1.Show vbModeless End Sub