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

تفضل وجدت هذا الامر بالتوفيق Second.accdb

بارك الله فيكم وجعله في ميزان حسناتكم. جميع الحلول رائعة وشغاله.

اخر نسخة

تمام اتفضل Employee.accdb

رسالة عند عدم وجود تاريخ Employee.accdb

اتفضل استاذ سامر هل هذا ما تريد Employee.accdb

بارك الله فيك وجزاك الله خير الجزاء

الحمد لله على قضاء الحاجات فقط احببت التنبيه الى ان طريقة تصميم الجداول غير صحيحة .. الافضل بيانات الجداول الثلاث تكون في جدول واحد

جرب Sub InsertPageBreaks() Dim ws As Worksheet Dim rowsPerPage As Integer Dim lastRow As Long Dim i As Long ' تعيين عدد الصفوف في كل صفحة rowsPerPage = 24 ' تحديد الورقة التي ترغب في تطبيق الفواصل عليها Set ws = ThisWorkbook.Sheets("Sheet1") ' تغيير "Sheet1" إلى اسم الورقة الخاصة بك ' حذف الفواصل الحالية إن وجدت ws.ResetAllPageBreaks ' الحصول على آخر صف غير فارغ في الورقة lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row ' إدراج فواصل الصفحات بعد كل rowsPerPage صف For i = rowsPerPage To lastRow Step rowsPerPage ws.Rows(i).PageBreak = xlPageBreakManual Next i End Sub قم بتغيير "Sheet1" في السطر Set ws = ThisWorkbook.Sheets("Sheet1") إلى اسم الورقة التي ترغب في تطبيق الفواصل عليها. قم بتعديل قيمة rowsPerPage إلى العدد المطلوب من الصفوف في كل صفحة.

والله والله لو في منك كتير كانت حاجات كتير اتغيرت في حياتنا ربنا يزيدك اخي الكريم @kkhalifa1960

ابشر !!!

مشكور جزاك الله خيرا

تفضل أستاذ @عمر طاهر المرفق يعرض كل مكونات الجدول . DD468.rar

شكراً استاذ @kkhalifa1960 مع فائق التقدير

تفضل استاذ @SAROOK محاولتي حسب مافهمت اليك المرفق والشرح . ووافني بالرد . الاجازات-1.rar

جرب هذا الاستعلام هل هذا ما تريد ؟ SELECT TA.الاسم FROM (TA INNER JOIN TB ON TA.الاسم = TB.الاسم) INNER JOIN TC ON (TC.الاسم = TA.الاسم) AND (TB.الاسم = TC.الاسم) GROUP BY TA.الاسم;

عليكم السلام =Nz(DLast("[رصيد نهائي]","[t1]"),0) test2.accdb

جرب Sub نقل_البيانات() Dim ws As Worksheet Dim wsResult As Worksheet Dim lastRow As Long Dim i As Long ' افتح ورقة العمل الحالية Set ws = ThisWorkbook.Sheets("Sheet1") ' استبدل "Sheet1" باسم ورقة العمل الخاصة بك ' قم بإنشاء ورقة النتيجة إذا لم تكن موجودة بالفعل On Error Resume Next Set wsResult = ThisWorkbook.Sheets("النتيجة هنا") On Error GoTo 0 If wsResult Is Nothing Then Set wsResult = Sheets.Add(After:=Sheets(Sheets.Count)) wsResult.Name = "النتيجة هنا" End If ' حساب آخر صف غير فارغ في عمود F lastRow = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row ' نقل البيانات إلى ورقة النتيجة باستثناء الأسطر الفارغة في عمود F For i = 1 To lastRow If ws.Cells(i, "F").Value <> "" Then ws.Rows(i).Copy wsResult.Rows(wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row + 1) End If Next i MsgBox "تم نقل البيانات بنجاح!" End Sub

لم أرى إلا نطاق tbl فاستخدمته بدلا من ListView1 كما أنه في آخر سطر مناداة لإجراء غير موجنود فعطلته actualistion. Private Sub UserForm_Initialize() 'With ListView1 With tbl .Gridlines = True 'affiche ou pas les lignes .View = lvwReport ' style de rapport .FullRowSelect = True ' permet de sélectionner une ligne dans la liste 'création des en-tétes personnalisées avec leur largeur .ColumnHeaders.Add Text:="الرقم", Width:=1 .ColumnHeaders.Add Text:="إسم المستفيد", Width:=60 .ColumnHeaders.Add Text:="حساب المستفيد", Width:=90 .ColumnHeaders.Add Text:="البنك", Width:=60 .ColumnHeaders.Add Text:="المبلغ", Width:=60 .ColumnHeaders.Add Text:="رقم الصك", Width:=60 .ColumnHeaders.Add Text:="تاريخ إجراء المعاملة", Width:=60 End With 'Call actualistion 'on appelle la procédure qui actualise la listview End Sub

تفضل استاذ @سامر محمود المرفق بعد التعديل . https://www.mediafire.com/file/2qeclwkbrlhmrjp/samer-Test-2-3.rar/file

جرب Sub كتابة_الصدق_كل_20_صف() Dim صف As Integer Dim الصدق As String الصدق = "الصدق" ' تحديد صفوف للكتابة فيها For صف = 1 To ActiveSheet.Rows.Count Step 20 ' كتابة الكلمة في الخلية A في الصف الحالي Cells(صف, 1).Value = الصدق Next صف End Sub

والله أتعبني الموضوع، أخي يفترض أن يكون سعر البيع المطلوب للبيع (متوسط الأسهم حالياً) يدخل يدويا وليس معادلة. جرب وخبرني. 111_01.xlsx

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

قم بتعديلها بما يناسبك Sub TEST() Dim i As Integer For i = 1 To 100 Step 50 Cells(i, 1).Value = "الصدق" Next i End Sub '''''''''''''''''''''' Sub test2() Dim X As Integer star = 1 ' اول خلية fin = 500 'اخر خلية For X = star To fin Step 50 Range("A" & X).Value = "الصدق" Next X End Sub