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

اتفضل استاذ احمد 2.rar

السلام عليكم مشاركه مع اخى العزيز @Foksh اتفضلى اطلعى ع الموضوع التالى استاذه @safaa salem5 لمعلمنا العزيز جعفر جزاه الله عنا كل خير بالتوفيق

وعليكم السلام 🙂 1. ممكن اضافة اسم "الموارد اليشرية" في الكود ، بحيث عند النقر على الزر ، يقارن الاسم الموجود في الحقل بالاسم الموجود في الكود ، وعليه يقوم بالحذف من عدمه ، ولكني أفضّل ان اضيف حقل اخر في الجدول ، نوع نعم/لا ، فلنسميه Delete_Me ، وبهذه الطريقة لا نكتب اسم "الموارد البشرية" في الكود ، وانما نعمل "صح" امامه. وكذلك يمكنك اضافة اي عدد من الاقسام التي لا تريد حذفها. اما الكود فيكون: اذا Delete_Me =-1 اذن احذف. 2. اذا كنت في صفحة الكود VBE ، اضغط على الزر F1 ، وابحث عن msgbox ، ثم انقر على Msgbox Function : . في الاسفل بيعطيك الكود ، واللي منه تقدر تجربه وتغيره حسب حاجتك ، فهو يعطيك مثال فيه نعم/لا : . 3. اما وجود الحقل الفارغ في اسفل السجلات ، لأنك تركت في اعدادات النموذج "الاضافة" (اضافة سجل) ، نعم ، بينما انت لا تريد الاضافة ، فغيره الى لا : . ليش ما عملت تغيير على مرفقك وريحتك وقللت العمل على نفسي ؟ حتى تستفيد من هذه الاجراءات لأسئلتك الاخرى 🙂 جعفر

ابدا بالعمل ، ولما تصادف مشكلة ، ارسلها هنا علشان نساعدك

وعليكم السلام ورحمة الله تعالى وبركاته Private Sub UserForm_Initialize() Set f = Sheets("التقرير") Set Rng = f.Range("A3:j" & f.[A65000].End(xlUp).Row) wsData = Rng.Value For i = LBound(wsData) To UBound(wsData): wsData(i, 5) = Format(wsData(i, 5), "0.00"): Next i For i = 1 To UBound(wsData): wsData(i, 6) = Format(wsData(i, 6), "0.00"): Next i 'Code............ '''''''''''' End Sub

وعليكم السلام 🙂 البرنامج غير مفتوح المصدر لأنه بصيغة accde ، فالطريقة الوحيدة عندك هي الرجوع الى صاحب البرنامج: http://www.acc-arab.com حتى يعدل عليه ،او الاتصال بالمبرمج: محمد عصام - مصـــــر - القاهــــــرة - Soul-angel@msn.com جعفر

تفضل رقم الهاتف.xlsx

على العموم ، من خلال تجربة سابقة لي في أحد برامجي ، جرب هذه الفكرة التي تتيح لك اختيار العنصر الذي تريد تحريكه ( مربع نص ، زر ، كومبوبوكس ) .... إلخ . بدايةً سنقوم بإنشاء مديول عام ولنفترض اسمه Drag_Drop وسيحتوي على هذا الكود البسيط :- Option Compare Database Option Explicit Public DragControl As Control Public XOffset As Single Public YOffset As Single Public Sub StartDrag(ctrl As Control, X As Single, Y As Single) Set DragControl = ctrl XOffset = X YOffset = Y End Sub Public Sub Dragging(X As Single, Y As Single) If Not DragControl Is Nothing Then DragControl.Left = DragControl.Left + (X - XOffset) DragControl.Top = DragControl.Top + (Y - YOffset) End If End Sub Public Sub EndDrag() Set DragControl = Nothing End Sub للتوضيح والشرح للمديول :- المتغير DragControl هو متغير من نوع Control يتم فيه تخزين العنصر الذي يتم سحبه حاليًا . المتغيران XOffset و YOffset هما من نوع Single وظيفتهما تخزن إحداثيات الماوس عند بداية عملية السحب . الدالة StartDrag التي ستعيد بدء عملية السحب للعنصر المحدد . حيث أنها تستقبل ثلاث معاملات [ ctrl (العنصر الذي يتم سحبه)، X و Y (إحداثيات الماوس في نقطة النقر) ] . الدالة Dragging التي تستخدم أثناء جر العنصر . حيث ستقوم بتحديث موقع DragControl (العنصر المحدد للسحب) بناءً على إحداثيات الماوس الحالية . وستستخدم XOffset و YOffset لضمان تحديث العنصر بالشكل الصحيح مع تحريك الماوس . الدالة EndDrag التي سوف تنهي عملية السحب بتفريغ قيمة DragControl ، مما يعني أنه لم يعد هناك عنصر يتم تحريكه . سنحتاج الجدول ControlPositions يتم تخزين قيم الموقع والإحداثيات لكل عنصر داخل أي نموذج . وسنحتاج إلى الحقول التالية ( ID و FormName و ControlName و ControlLeft و ControlTop ) . وهي بعد الحقل ID ترقيم تلقائي ( حقل لإسم النموذج ، وحقل لاسم العنصر داخل هذا النموذج ، وحقلين للإحداثيات ( اليسار والأعلى ) لكل عنصر . الآن في النموذج الذي سيتم التنفيذ عليه ؛ نقوم بوضع هذه الأكواد ( حجز المتغيرات والثوابت ، والإحداث عن الاغلاق والفتح ، والتحريك للماوس ) للنموذج فقط .. Option Compare Database Option Explicit Public DragControl As Control Public XOffset As Single Public YOffset As Single Public Sub StartDrag(ctrl As Control, X As Single, Y As Single) Set DragControl = ctrl XOffset = X YOffset = Y End Sub Public Sub Dragging(X As Single, Y As Single) If Not DragControl Is Nothing Then DragControl.Left = DragControl.Left + (X - XOffset) DragControl.Top = DragControl.Top + (Y - YOffset) UpdateControlPosition DragControl End If End Sub Public Sub EndDrag() Set DragControl = Nothing End Sub Private Sub Form_Load() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim ctrl As Control Set db = CurrentDb Set rs = db.OpenRecordset("ControlPositions", dbOpenDynaset) Do While Not rs.EOF For Each ctrl In Me.Controls If ctrl.Name = rs!ControlName Then ctrl.Left = rs!ControlLeft ctrl.Top = rs!ControlTop Exit For End If Next ctrl rs.MoveNext Loop rs.Close Set rs = Nothing Set db = Nothing End Sub Private Sub Form_Close() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim ctrl As Control Set db = CurrentDb Set rs = db.OpenRecordset("ControlPositions", dbOpenDynaset) strSQL = "DELETE * FROM ControlPositions WHERE FormName='" & Me.Name & "'" db.Execute strSQL, dbFailOnError For Each ctrl In Me.Controls If TypeOf ctrl Is Control Then strSQL = "INSERT INTO ControlPositions (FormName, ControlName, ControlLeft, ControlTop) " & _ "VALUES ('" & Me.Name & "', '" & ctrl.Name & "', " & ctrl.Left & ", " & ctrl.Top & ")" db.Execute strSQL, dbFailOnError End If Next ctrl rs.Close Set rs = Nothing Set db = Nothing End Sub Private Sub UpdateControlPosition(ctrl As Control) Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Set db = CurrentDb Set rs = db.OpenRecordset("ControlPositions", dbOpenDynaset) strSQL = "SELECT * FROM ControlPositions WHERE FormName = '" & Me.Name & "' AND ControlName = '" & ctrl.Name & "'" If Not rs.EOF Then rs.Edit rs.Fields("ControlLeft").Value = ctrl.Left rs.Fields("ControlTop").Value = ctrl.Top rs.Update Else rs.AddNew rs.Fields("FormName").Value = Me.Name rs.Fields("ControlName").Value = ctrl.Name rs.Fields("ControlLeft").Value = ctrl.Left rs.Fields("ControlTop").Value = ctrl.Top rs.Update End If rs.Close Set rs = Nothing Set db = Nothing End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Not Me.ActiveControl Is Nothing Then StartDrag Me.ActiveControl, X, Y End If End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then Dragging X, Y End If End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) EndDrag End Sub الآن نأتي للأحداث الخاصة بالعناصر التي نرغب في منح المستخدم حرية تغيير مواقعها . وسأبدأ بالتنفيذ على ( مربع نص TextBox1 و زر Command10 ) فقط ، والباقي مجرد تكرار مع تغيير الأسماء للعناصر . Private Sub TextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Form_MouseDown Button, Shift, X, Y End Sub Private Sub TextBox1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Form_MouseMove Button, Shift, X, Y End Sub Private Sub TextBox1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Form_MouseUp Button, Shift, X, Y End Sub Private Sub Command10_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Form_MouseDown Button, Shift, X, Y End Sub Private Sub Command10_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Form_MouseMove Button, Shift, X, Y End Sub Private Sub Command10_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Form_MouseUp Button, Shift, X, Y UpdateControlPosition Me.ActiveControl End Sub وهذا المرفق تنفيذ ما تم شرحه سابقاً Move And Drops.accdb

32bit (X!) للمساعدة اظن انك كنت فاتح نفس الموضوع وغلق ❤️ ليش صورة شيك بنك برقان داخل الملف الطريقة خلي حدث عند الضغط المزدوج تساوي الحقل وفي اربع ازرة صورة PNG فارغة (شفاف) + كود تحصل موقع منتدى المبرمجين العرب لتغير شكل الماوس وخله شكل مؤشر الماوس يمسك اي جهه تحرك الماوس يتحرك العنصر معاك =0 وعند الضغط مزدوج يلغي التحريك ويغير شكل الماوس الى الطبيعي Bit 64 و Bit 32! X NO $ ================================ (مثال للتطبيق والتجربة) صوره من التحديث لبرنامج آخر بس بيرفعة بموقع ثاني واعتذرة لشخص على Hotmail بالتوفيق moveButton_IN_Form.rar

تفضل ................ 1.accdb

تفضل ....................... 2024.mdb

ادن اخي الكريم يمكنك الابداع في ظبط التنسيقات المرغوبة وان شاء الله سنحاول مساعدتك في اظافتها لوقة الطباعة بعد كل استعلام بطريقة ما

وعليكم السلام ورحمة الله تعالى وبركاته Option Compare Text Public Property Get F() As Worksheet: Set F = Worksheets("Sheet1") End Property Sub Sort_Category() Dim OneRng As Range Dim lr As Long lr = F.Cells(Rows.Count, "E").End(xlUp).Row Set OneRng = F.Range("A2:L" & lr) With OneRng .Sort Key1:=.Columns(5), Order1:=xlDescending, Header:=xlNo End With End Sub '***************************** Sub Filter_and_create_Sheets() Application.DisplayAlerts = False Application.ScreenUpdating = False F.[w1] = F.[E1] RngA = F.[A1].CurrentRegion.Rows.Count RngB = F.[A1].CurrentRegion.Columns.Count F.[A1].Resize(RngA, RngB).AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=F.[w1], Unique:=True For Each c In F.Range("W2:W" & F.[W65000].End(xlUp).Row) F.[W2] = c.Value On Error Resume Next Sheets(CStr(c.Value)).Delete On Error GoTo 0 Sheets.Add After:=Sheets(Sheets.Count) Set n = ActiveSheet n.Name = CStr(c.Value) n.DisplayRightToLeft = True F.[A1].Resize(RngA, RngB).AdvancedFilter Action:=xlFilterCopy _ , CriteriaRange:=F.[W1:W2], CopyToRange:=[A1] For r = 1 To 12 n.Cells.EntireRow.AutoFit n.Columns(r).ColumnWidth = F.Columns(r).ColumnWidth Application.ErrorCheckingOptions.NumberAsText = False Next Next c F.Activate End Sub تقرير صف أول 2025.xlsm

حمدلله على السامة نورت المنتدى Laboratory_2024.accdb

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