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

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

تفضل الملف كامل . ما عليك إلا أن تكتب البيانات في صفحات الشهور و سيظهر الفرز تلقائيا في صفحة تم أو غير مسدد 4الحساب.xlsx

الخبير الفاضل صاحب الابداع المستمر خالص الشكر لك

الف شكر باشمهندس زادك الله علما ورفعة .. ورزقك من حيث لا تحتسب

🌷 لقاءات أكسس العرب الافتراضية | 03 | 🌷 موضوع اللقاء : مهارات وفنيات تصميم النماذج واختيار الألوان وتنسيق العناصر رابط اليوتيوب: ★ روابط اللقاء الثالث ★ ○ موقع إلهام : https://www.pinterest.com https://www.freepik.com ○ مواقع اختيار الألوان : https://coolors.co https://colorhunt.co https://www.materialpalette.com https://coolors.co/gradients ○ مواقع الأيقونات : https://icons8.com/icons https://www.flaticon.com https://icon-icons.com/ https://www.iconarchive.com/ https://flaticons.net/free-icons ○ مواقع صور PNG : https://www.cleanpng.com https://www.pngwing.com https://www.seekpng.com ○ مواقع صور خلفيات : https://www.pexels.com https://www.freepik.com/free-photos-vectors/background https://pixabay.com https://www.vecteezy.com/free-photos/background https://stocksnap.io/search/background ○ مواقع الخطوط : https://fonts.google.com https://arbfonts.com خطوط رسومية : https://www.vertex42.com/ExcelTips/unicode-symbols.html https://www.ssec.wisc.edu/~tomw/java/unicode.html ○ مراجع مهمة : https://elshemy.me/content/2025_8/Access_UI_UX_ِGuide.html ★ روابط تهمك ★ ❀ ملفات اللقاءات الافتراضية : ○ https://shorturl.at/mR2T3 ○ اللقاء الأول : https://drive.google.com/drive/folders/1wiMVugVZNzU9eaJ9abX-YfqhhSG6_Ec5 ○ اللقاء الثاني : https://drive.google.com/drive/folders/1EcaTZBp0rhmxhm7c_NKOg6BC-O89DS4W ○ اللقاء الثالث : https://drive.google.com/drive/folders/1VX4an_hg3ZdX-Q9_MlNNPoCzkCN6b98d ○ برمـجيـات - أدوات - إضـافـات : https://drive.google.com/drive/folders/1RtmH-cuk1rpj0zKkUNPbQz681oqKVNo3 ○ مجلد ورش العمل المشتركة : https://drive.google.com/drive/folders/1LL5_hsElZR4zQv62Wt1TxU2_M8Gv1Jja ❀ رابط الانظمام لمجموعة الأكسس جروب (واتسأب) : https://chat.whatsapp.com/HQvOPGrkASM2guvAotHXCw ❀ قناة أكسس العرب (اليوتيوب) : http://www.youtube.com/@ArabAccessGroup ❀ مواضيع اللقاء : المقدمة الإلهام البصري pinterest الإلهام البصري Google اختيار الألوان المناسبة تطبيق الألوان على قاعدة البيانات الأيقونات النصية الأيقونات الأيقونات - برنامج Pichon إضافة الصور المفرغة PNG تصميم الواجهات عن طريق PowerPoint حفظ التصميم من الباوربوينت واستيراده إلى الأكسس تصميم نموذج تسجيل الدخول إضافة التفاعل البصري للعناصر تفاعل بصري بالتنسيق الشرطي التأثيرات البصرية التي تطبق على الأزرار الخطوط في النماذج وتنسيقاتها الأنماط اللونية أنماط الخطوط مشاهدة ممتعة 😊🌷

تفضل اخي تم الاعتماد على رقم التسلسل لتعديل البيانات او حدفها بحكم انه هو الوحيد الغير مكرر عندك على الجدول Sub Délete_Client() ' حدف Dim WS As Worksheet, WS2 As Worksheet Dim i As Long, ST As Long Dim msg As VbMsgBoxResult, Client As String Set WS = Worksheets("Orders") Set WS2 = Worksheets("Items") Client = WS2.Range("F4") N_row = WS2.Range("W1") Application.ScreenUpdating = False If Client = Empty Then MsgBox Client & "المرجوا تحديد الصف المراد حدف بياناته", vbExclamation, "إنتباه" Exit Sub End If msg = MsgBox(" هل انت متأكد من حدف : " & Client, vbYesNo + vbQuestion + vbDefaultButton2, "إنتباه") Application.ScreenUpdating = False If msg = vbNo Then Exit Sub End If WS.Activate For i = Cells(Rows.Count, 2).End(xlUp).Row To 7 Step -1 If Cells(i, 2).Value = N_row Then Rows(i).Delete End If Next i For ST = 7 To Cells(Rows.Count, "B").End(xlUp).Row If Cells(ST, "c").Value <> "" Then Cells(ST, "b").Value = ST - 6 End If Next ST WS2.Activate WS2.Range("H15,F4,F6,H6,F9,H9,J9,F13,H13,J13,F15,J15,F18,H18,F20,J21,w1") = Empty Application.ScreenUpdating = True m = MsgBox("تم حدف البيانات بنجاح", 64, "تأكيد") End Sub Dynamic Orders - Pivot_V6.xlsm

تفضل اخي كود لنقل البيانات من شيت (Ordres) الى شيت (Items) بدوبل كليك على عمود اسم العميل Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) On Error Resume Next Dim lastrow As Long Dim Row_Clt As Worksheet: Set Row_Clt = Worksheets("Items") Dim sh As Worksheet: Set sh = Worksheets("Orders") lastrow = sh.Cells(sh.Rows.Count, "d").End(xlUp).Row Set ws_data = ActiveCell If Intersect(Target, Range("D7:D" & lastrow)) Is Nothing Then Else Application.ScreenUpdating = False Row_Clt.Range("F4") = ws_data.Value Row_Clt.Range("F6") = ws_data.Offset(0, 1).Value Row_Clt.Range("H6") = ws_data.Offset(0, 2).Value Row_Clt.Range("F9") = ws_data.Offset(0, 3).Value Row_Clt.Range("H9") = ws_data.Offset(0, 4).Value Row_Clt.Range("J9") = ws_data.Offset(0, 5).Value Row_Clt.Range("F13") = ws_data.Offset(0, 6).Value Row_Clt.Range("H13") = ws_data.Offset(0, 7).Value Row_Clt.Range("J13") = ws_data.Offset(0, 8).Value Row_Clt.Range("F15") = ws_data.Offset(0, 9).Value Row_Clt.Range("H15") = ws_data.Offset(0, -1).Value Row_Clt.Range("J15") = ws_data.Offset(0, 10).Value Row_Clt.Range("F18") = ws_data.Offset(0, 11).Value Row_Clt.Range("H18") = ws_data.Offset(0, 12).Value Row_Clt.Range("F20") = ws_data.Offset(0, 14).Value Row_Clt.Range("H20") = ws_data.Offset(0, 15).Value End If On Error GoTo 0 Application.ScreenUpdating = True End Sub واليك الملف بعد اظافة اكواد الترحيل والتعديل والحدف Dynamic Orders - Pivot_V3.xlsm

تفضل جرب اخي لاكن حاول دائما عدم طلب اكثر من طلب في موضوع واحد لكي يستطيع الاساتدة مساعدتك. لا احد لديه الوقت الكافي لاتمام كل الطلبات ...عند الانتهاء من ترحيل البيانات بنجاح قم بفتح وضوع جديد. وسوف نكون سعداء بمساعدتك. بالتوفيق.......... Sub Transfer() ' ترحيل Dim rng As Range, line As Range, cl As Range Dim C As Long, lastrow As Long Dim msg As VbMsgBoxResult Dim WSdata As Worksheet: Set WSdata = Worksheets("Items") Dim WSdest As Worksheet: Set WSdest = Worksheets("Orders") lastrow = WSdest.Cells(WSdest.Rows.Count, "C").End(xlUp).Row Application.ScreenUpdating = False 'التحقق من وجود بيانات على الخلايا التالية WSdata.Activate Arr = Array([F4], [F6], [H6], [H9], [H9], [F13], [H13], [J13]) For i = 0 To 7 If Arr(i) = Empty Then MsgBox " المرجوا ملء بيانات " & Arr(i).Offset(0, -1), vbExclamation, "إنتباه" Arr(i).Select Exit Sub End If Next 'التحقق من وجود اسم العميل مسبقا لمنع التكرار If Application.WorksheetFunction.CountIf(WSdest.Range("D:D"), WSdata.Range("F4").Value) > 0 Then MsgBox "إسم العميل مضاف مسبقا", vbExclamation, "إنتباه" Exit Sub End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''' msg = MsgBox("ترحيل البيانات ؟ ", vbYesNo + vbQuestion + vbDefaultButton2, "") If msg = vbNo Then Exit Sub Else End If Set rng = WSdata.Range("H15,F4,F6,H6,F9,H9,J9,F13,H13,J13,F15,J15,F18,H18,J18,F20,H20") C = 3 For Each cl In rng cl.Copy WSdest.Cells(lastrow + 1, C).PasteSpecial xlPasteValues C = C + 1 Next cl 'تسلسل البيانات With WSdest.Range("B7:B" & lastrow + 1) .Formula = "=Row() - 6" .Value = .Value End With Application.CutCopyMode = False 'حدف الصفوف الفارغة On Error Resume Next Set line = Range("Orders[[إسم العميل]]").SpecialCells(xlCellTypeBlanks) If Not line Is Nothing Then line.Delete Shift:=xlUp End If On Error GoTo 0 'افراغ الخلايا WSdata.Range("H15,F4,F6,H6,F9,H9,J9,F13,H13,J13,F15,J15,F18,H18,F20,H20") = Empty Application.ScreenUpdating = True m = MsgBox("تم ترحيل البيانات بنجاح", 64, "تأكيد") End Sub

وعليكم السلام-كان عليك استخدام خاصية البحث بالمنتدى-تفضل تفقيط مساحة ارض

اتفضل المطلوب: تم عمل التعديلات الاتية: 1- بعض التعديل على كود الترحيل للتأكد من (عدم تكرار رقم الفاتورة - قيام المستخدم بملء البيانات بالكامل - تنظيف الفورم بعد الترحيل) وترحيل ارقام الفواتير المدخلة الى شيت مستقل 2- إضافة شيت مخصوص لعملية الاستدعاء والتعديل والحذف مع تعديل كود الاستدعاء ليكون حسب رقم الفاتورة فقط Accounting.rar