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

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

يمكنك استعمال هذا الماكرو لنقل الأسماء الى الجداول المحصصة لكل طالب لان عملية نسخ الجدول ولضقه اكثر من مرة ليست بالأمر السهل خاصة اذا كان عدد الطلاب كبير (50 أو اكثر) فقط اضغط على الزر Give Data في الشيت Repport و ترى كل شيء امامك الجداول والاسماء فيها (بدون معادلات) عندها تملأ الداتا الحاصة لكل تلميذ و بدورها تنتقل الى الشيت ترحيل الماكرو Option Explicit Sub copy_Range() Dim S As Worksheet Dim R As Worksheet Dim i%, k%, x Dim Rg_To_Copy Application.ScreenUpdating = False Set S = Sheets("ST_names") Set R = Sheets("Repport") Set Rg_To_Copy = R.Range("A1:D13") i = 2: k = 16 R.Range("A16").Resize(1000, 4).Clear Do Until S.Range("A" & i).Offset(1) = vbNullString Rg_To_Copy.Copy R.Range("A" & k).PasteSpecial (xlAll) R.Range("B" & k + 1).Resize(10).ClearContents R.Range("D" & k + 1).Resize(10).ClearContents With R.Range("A" & k) .Offset(1, 1) = x + 2 .Offset(2, 1) = S.Range("D" & i + 1) .Offset(1, 3) = S.Range("F" & i + 1) End With k = k + 15: x = x + 1: i = i + 1 Loop Application.CutCopyMode = False Application.ScreenUpdating = True R.Cells(2, 1).Select End Sub الملف مرفق للاطلاع وإبداء الرأي Haggag_1.xlsm

جرب هذا الملف Haggag.xlsx

أسأل الله رب العرش العظيم أن يشفيهما وان يشفي زوجتي وكل مريض

بالانتظار بالانتظار

اللهم اشفي والديه بمنك وكرمك شفاءا لا يغادر سقما وجميع مرضا المسلمين ومتعهم بالصحة والعافية ما أحييتهم يا رب العالمين اللهم اجعل ما أصبتهم رفعة في درجاتهم وزيادة في أجورهم يا رب العالمين آمين الحقيقة اكثر مالفت نظري وجعلني اقف لك بكل احترام وتقدير كود xml في جدول USysRibbons وبالرغم من اجادتي لهذة اللغة واستخدامي لها في اكسس وغيرها الا اني اجد الكود الذي قمتم بكتابتة رائع ومختصر ويؤدي المطلوب بشكل جميل ويجيب عن استفسارات كثيرة لرواد الموقع واعتبره مرجع لمن يريد انشاء قوائم للاصدارات من 2007 - 2019 ولعلنا سوينا نجد وقت مناسب لشرح استخدام هذه الوسوم وخصوصا ان استخدامها لا يقتصر على زر امر وانما يمكن عمل قوائم ديناميكية وخانات احتيار ومربعات بحث تغني عن وضع مربع نص داخل النموذج الخ بارك الله فيك اخي صالح وجعل ماتقدمه من عمل في ميزان اعمالك تحياتي وتقديري

لحظات _ ان شاء الله _ وارسلها لك على الخاص

أهلا بك.. نعم.. الشفرة التالية تقوم بالتحديث والإدراج معاً! Sub UPDATE_FROM_EXCEL() '-- GET EXCEL FILE Dim XL_FILE As String XL_FILE = CurrentProject.Path & "\ITEMX.xlsx" '-- WRITE SQL STATEMENT Dim SQL As String SQL = SQL & "UPDATE TABLE1 AS T1 " SQL = SQL & "RIGHT JOIN " SQL = SQL & "(SELECT * FROM [SHEET1$] IN'" & XL_FILE & "'" SQL = SQL & "[EXCEL 12.0;HDR=YES;IMEX=1;]) AS T2 " SQL = SQL & "ON T1.[كود_الصنف] = T2.[كود الصنف] " SQL = SQL & "SET T1.[كود_الصنف] = T2.[كود الصنف]," SQL = SQL & "T1.[اسم_الصنف] = T2.[اسم الصنف]" '-- RUN SQL STATEMENT CurrentDb.Execute SQL End Sub ITEMX.accdb ITEMX.xlsx

وعليكم السلام ... من فضلك هذا منتدى عربى وليس كل الناس لديم دراية ومعرفة باللغة الفرنسية عليك بعرض مشكلتك وطلبك باللغة العربية حتى تستطيع الأساتذة مساعدتك تفضل- Seroprevalence1.xlsx

أبو قاسم أين انت من هذه الإجابة الممتازة؟!!! أين الضغط على الإعــــجـــــاب , وكما اتفقنا ان هذا أقل ما يقدم لمن له الفضل عليك بعد ربنا فى حل مشكلتك وتفريج كربتك ولا تتعالى عن فعل هذا ؟!!!💙

جرب المرفق لعله يفي بالغرض المصنف1( (1).xlsm

السلام عليكم ابو اشرف يمكنك استيراد الجداول الى قاعدة Accdb

السلام عليكم قم بازالة الرقم السري من الملف ثم اعد حفظ الملف بالامتداد الذي تريده وهذه طريقة ازالة الرقم السري https://www.youtube.com/watch?v=8Fq8UurH8MQ

و عليكم السلام و رحمة الله وبركاته يجب تغيير اسماء الاوراق بما يتطابق تماما مع اسماء الاعمدة لكي يتم وضع كل بند في ورقته الكود موجود في حدث التغيير في الورقة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 4 And Target.Column >= 4 _ And Target.Column < 20 Then For Q1 = 3 To Sheets.Count If Sheets(Q1).Name = Cells(3, Target.Column).Text _ Then GoTo 8 Next MsgBox "Nun" & Cells(3, Target.Column).Text GoTo 9 8 Set TS = Sheets(Cells(3, Target.Column).Text) Q1 = Cells(Target.Row, 22).Text Q2 = Cells(Target.Row, Target.Column).Value With TS For TR1 = 8 To 99 If .Cells(TR1, 5) = Q1 Then .Cells(TR1, 3) = Q2 GoTo 9 End If Next For TR2 = 8 To 99 If .Cells(TR2, 5) = "" Then .Cells(TR2, 5) = Q1 .Cells(TR2, 3) = Q2 GoTo 9 End If Next End With End If 9 End Sub مرفق الملف مع التحية اداري تعديل.xls

ما هو امتداد الملف المراد تحويله اخي الكريم اذا كان accde فلا تحاول تحويله فلن يمكن ذلك تحياتي

عليكم السلام ورحمة الله اخي الكريم اليك هذا العمل حسب ما فهمت في مشاركتك Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim LR As Long Dim rng Dim tot Set tot = Range("b10") Set rng = Range("b2:b9") If Not Intersect(Target, rng) Is Nothing Then Range("b10").Formula = "=SUM(B2:B9)" If Range("b10") > 100 Then MsgBox "خطأ في الادخال" Target = "" Target.Activate End If End If End Sub test.xlsm

اين ذهبت الأرقام؟؟؟؟ اليك الملف كاملاً مع زر الطباعة Ritage_With_Print.xlsm

لا أعلم السبب عندك سبب طهور الرسالة هو ان هذه الرحلة موجودة فعلاً لذلك يجب 1- حذفها أولاً من الشيت داتا الزر رفم 2 لان الماكرو لا يضيفها اذا كانت موجودة في هذا الشيت( لا يسمح بالتكرار) 2- اجراء التعديلات اللازمة 3-ارسالها الى الشيت داتا من جديد الزر رفم 5 4-التأكد من ان كل شيء في مكانه الصحيح بواسطة الزر 6 استدعاء عندي بعمل بشكل طبيعي تأكد من اجراء الخطوات بشكل صحيح بالنسبة للطباعة هذا الكود Sub Print_Me() Dim My_last%, Inv As Worksheet Set Inv = Sheets("Invoice") My_last = Application.Max(Inv.Range("B13:B32")) + 12 Inv.PageSetup.PrintArea = Inv.Range("B1:G" & My_last).Address Inv.PrintPreview End Sub مع امكانية استبدال السطر (الذي يظهر منظر الصفحة قبل طباعتها) Inv.PrintPreview بهذا السطر (الذي يرسل الصفحة مباشرة الى الطباعة) Inv.PrintOut

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

السلام عليكم بارك الله فيك وجعله في ميزان حسناتك

عليكم السلام جرب هذا التعديل ولكن مذا عن استعراص البيانات في الفورم ؟ سيأتر هذا عن ذلك وستضطر لتعديل الفورم Private Sub CommandButton1_Click() Dim ws As Worksheet Set ws = ActiveWorkbook.Sheets("invoice") Dim wss As Worksheet Set wss = ActiveWorkbook.Sheets("Sheet1") Dim DT Dim Nam Dim lr As Long Application.ScreenUpdating = False Application.EnableEvents = False lr = wss.Range("a" & Rows.Count).End(xlUp).Row + 1 DT = ws.Range("e5") & Format(Now(), " ss - mm - hh - yyyy - mm - dd ") With ws Application.DisplayAlerts = False Nam = .Range("e5") & " " & Format(Now(), " ss - mm - hh - yyyy - mm - dd ") ThisWorkbook.SaveCopyAs Filename:="D:\back\Backup\" & Nam & ".xlsm" ' '========================================= End With If ws.Range("F5").Value = "نقدي" Then Else: wss.Range("a" & lr).Value = ws.Range("e5") wss.Range("b" & lr).Value = Format(Now(), " ss - mm - hh - yyyy - mm - dd ") wss.Range("C" & lr).Value = "اجل" End If If ws.[f5].Text = "اجل" Then Else: wss.Range("a" & lr).Value = ws.Range("e5") wss.Range("b" & lr).Value = Format(Now(), " ss - mm - hh - yyyy - mm - dd ") wss.Range("C" & lr).Value = "نقدي" End If Application.ScreenUpdating = True Application.EnableEvents = True End Sub

احسن الله اليك كما احسنت ورحم الله والدينا والديك تمام شكرا الف شكر

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد... المصنف2 (1).xlsm

السلام عليكم جمعة مباركة هديتي لكم هذا اليوم فورم بحث وتظهر نتائجه في تاكستات بوكس لكل خلية على شكل قائمة لست وبامكانك التعديل المباشر خلال التاكستات وبدوره تتغير البيانات تلقائيا بالنسبة للتاكست الي فيه لاين طويل يظهر له زر التمرير اثناء وجودك عليه لترى كامل محتوى التاكست ياخذ تلقائيا عرض الليبلات المجهزة داخل الفرمة وبامكانك حذف اوزيادة الليبلات لتشمل بيانات اخرى جعلنا هذا العمل هنا وهو طلب لاحدهم لتعم الفائدة مرفق ملف اكسل 2003 جمعة مباركة على الجميع Listbox Form5.rar

هذا الكود بيمسك السجل الحالي لكي تتم DoCmd.RunCommand acCmdSelectRecord وهذا الكود بيحذف اللي حدد من قبل DoCmd.RunCommand acCmdDeleteRecord

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

كود لاضافة زر تصغير لليوزرفورم Add Minimize Button To Userform.zip

اخواني الكرام جزاكم الله خيرا كان هناك احد الاخوة طرح سؤالا في ما يخص ملف البحث عن على الرابط التالي وذلك لاستخراج بيانات السطر كله (حتى العمود H) اثناء البحث و هذا تعديل للملف بحث عن.rar

اخي واستاذي العزيز يحياوي : مرفق كود : كود ترحيل ( كود نقل بيانات مباشرة بدون زر امر ) - يتم الترحيل بمجرد كتابة الكلمة المطلوبة من اعمال الاستاذ - HaNcOk - " احمد فضيلة " وفقك الله ياسر الحافظ " ابو الحارث " كود نقل بيانات مباشرة بدون رز امر.rar