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

السلام عليكم أخي الكريم طرحت سؤالك على برنامج دردشة ميكروسوفت فكان الجواب كالتالي: يتم استخدام خاصية StartUpPosition في إكسل لتحديد موقع ظهور UserForm عندما يتم فتحه لأول مرة. يمكن تعيين قيمة StartUpPosition إلى واحدة من أربع إعدادات. يمكنك استخدام الإعدادات التالية لـ StartUpPosition: Manual: لا يوجد إعداد أولي محدد. CenterOwner: يتم وضع UserForm في المركز على العنصر الذي ينتمي إليه UserForm. CenterScreen: يتم وضع UserForm في المركز على الشاشة بأكملها. WindowsDefault: يتم وضع UserForm في الزاوية اليسرى العليا من الشاشة. - يمكن تعيين خاصية StartUpPosition برمجيًا أو من نافذة الخصائص. يمكنك الرجوع إلى المصادر المذكورة أدناه لمزيد من المعلومات. رابط1 رابط2 أرجو لكم الفائدة. والسلام عليكم

اليك اخي طريقة اسرع في حالة وجود عدد كبير من الصفوف المرحلة الكود اطول لاكن اسرع بكثير من الاول 😄يمكنك ترحيل 400 صف في 2 ثواني تقريبا Sub Copy_Reports2() '''''''''''''''''' New additions to speed up code execution '""""""""""""""""""" Dim ws As Worksheet: Set ws = Sheets("البيانات") Dim wsDest As Worksheet: Set wsDest = Worksheets("تقسيم") Dim sMsg As String, rHeaders As Range, ligne As Range, t1 As Range, t2 As Range Dim LastRow&, Titles&, Cpt&, lastCol&, col&, rngCell, r&, c As Range, Réf&, N& temps = Timer With Application .EnableEvents = False .ScreenUpdating = False End With limite = ws.Evaluate("SUM(0+(A4:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row & "<>""""))") Set rHeaders = ws.Range("A1:P3") Set ligne = wsDest.[A5] wsDest.Cells.Clear For x = 4 To ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If ws.Range("A" & x) <> "" Then: Rng = ws.Range("A4:P" & x) début = 1: TailleBloc = 10: décal = 0: Next Do While début <= UBound(Rng) fin = début + TailleBloc - 1: If fin > UBound(Rng) Then fin = UBound(Rng) b = Application.Index(Rng, Evaluate("Row(" & début & ":" & fin & ")"), Application.Transpose(Evaluate("Row(1:" & UBound(Rng, 2) & ")"))) If ligne = 0 Then wsDest.Range("a" & Rows.Count).End(xlUp).Offset(3).Resize(UBound(b), UBound(b, 2)) = b Else Réf = wsDest.Columns("A:A").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row wsDest.Range("A" & Réf + 6).Resize(UBound(b), UBound(b, 2)) = b End If décal = décal + UBound(Rng, 2) + 1: début = fin + 1 Loop wsDest.Activate With wsDest.Cells .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: ActiveWindow.ScrollRow = 1: ActiveWindow.ScrollColumn = 1 .RowHeight = 40: .Columns(10).ColumnWidth = 23: .Columns(15).ColumnWidth = 16: .Font.Size = 16: .Font.Name = "Arial" End With LastRow = wsDest.Range("A:P").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Set rngCell = wsDest.Range("A3 :P" & LastRow) rngCell.Borders.LineStyle = xlNone For Each c In rngCell.Rows If WorksheetFunction.CountA(c) > 0 Then c.Borders.LineStyle = xlContinuous Next Cpt = 14 N = 1 For Titles = 1 To LastRow Step Cpt If wsDest.Cells(Titles, "A").Offset(5, 0) <> "" Then rHeaders.Copy wsDest.Cells(Titles, 1).Cells(1).PasteSpecial xlPasteAllUsingSourceTheme, , False, False Set t1 = wsDest.Cells(Titles, "B").Offset(13, 0) Set t2 = wsDest.Cells(Titles, "C").Offset(13, 0) t1.Interior.Color = RGB(204, 255, 255): t1.Value = " رقم القائمة" t2.Value = N: t2.Interior.Color = RGB(204, 255, 255) Titles = Titles + 1 N = N + 1 End If Next Titles Application.CutCopyMode = False With wsDest For i = 3 To LastRow On Error Resume Next If wsDest.Cells(i, "M") Like "الكمية المحتسبة" And wsDest.Cells(i, "M").Offset(10, 0) <> "" Then 'تلوين الخلفية wsDest.Cells(i, "j").Offset(11, 0).Resize(, 7).Interior.Color = vbYellow: wsDest.Cells(i, "J").Offset(11, 0).Value = "المجموع" wsDest.Cells(i, "M").Interior.Color = vbYellow: wsDest.Cells(i, "O").Interior.Color = vbYellow 'الكمية المحتسبة wsDest.Cells(i, "M").Offset(11, 0) = WorksheetFunction.Sum _ (Range(Cells(i, "M").Offset(1, 0), Cells(i, "M").Offset(10, 0))) 'المبلغ الكلي wsDest.Cells(i, "O").Offset(11, 0) = WorksheetFunction.Sum _ (Range(Cells(i, "O").Offset(1, 0), Cells(i, "O").Offset(10, 0))) ' النقص wsDest.Cells(i, "P").Offset(11, 0) = WorksheetFunction.Sum _ (Range(Cells(i, "P").Offset(1, 0), Cells(i, "P").Offset(10, 0))) End If Next i [A3].Select End With On Error GoTo 0 sMsg = " تم ترحيل" & " " & limite & " مستند " & " " & "بنجاح" MsgBox sMsg & vbCrLf & vbCrLf & " " & " " & "تم تنفيد الكود في: " & Format(Timer - temps, "0.0000"), Exclamation, "اوفيسنا" With Application .EnableEvents = True .ScreenUpdating = True End With End Sub اضافة رقم القائمة 2.xlsm

السلام عليكم ورحمة الله وبركاته وبها نبدأ من فترة كبيرة لم أدخل المنتدى وبالفعل أشتاق اليكم يشرفني ان ارفع شرح أحد الأفكار البسيطة كنت قد قدمتها وهي بالفعل نقطة في بحر القائمين على المنتدى

السلام عليكم بناءا على طلب بعض الاخوة اقدم لكم برنامج صغير لارشفة الصور برنامج ارشفه.accdb

عن طريق الاستعلام تفقيط الارقام فى الاكسس.accdb

الحمد لله على حل المشكلة ... لكن كيف حصلت على صورة الأرقام مع الحروف وهى ليست فى المثال المرفق ... هل يمكن ارفاه للإفادة وشكرا ....

تفضل أخي @Saif Hosam محاولتي ووافني بالرد . تفضل المرفق . Search in 8 fields.rar

أحسنت بارك الله فيك وزادك الله من فضله

بارك الله فيك استاذنا الغالي ابو يوسف @محمد حسن المحمد

وبارك لكم وبكم وعليكم أستاذنا الكريم @أ / محمد صالح

وبالنسبة للخطأ ، تستطيع التحايل على الآكسيس بأن تجعل الترقيم لا يكون عن طريق الترقيم التلقائي في الجدول . مثلاً إجعل الترقيم يكون باستخدام الدالة Dmax مثلاً .. وجرب الطريقة إن لم تكن مضطراً لتغيير العلاقات أو ..... إلخ .

يشرفني ان حضرتك تقرأ الموضوع وتثني عليه فأنتم قامة من قامات العلم

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

وعليكم السلام ورحمة الله وبركاته ، مبروك حل المشكلة ،

السلام عليكم ورحمة الله أخوتى الكرام هذا بالتفصيل ما قمت به وقد تم تعديل اللغة : 1 - تم تغير نسخة الويندوز إلى ويندوز 10 pro مع العلم أنها نفس النسخة السابقة . 2- لم أقم ببتعديل اعدادت اللغة أو إضافة أى لغة انما الاعدادات العادية للغة الانجليزية . 3 بعد الانتهاء من نسخة الويندز اضفت اللغة العربية . 4 - اضافة فوت خطوط عربية للخطوط 5- تثبيت نفس نسخة الاوفيس 2010 . وهذه هى النتيجة والحمد لله . . وشكرا على مجهودكم الكريم وزادكم الله من فضله وشكرا لمنتدنا واعضاء الكرام.

لو تبغي تشغيل هذه الخاصية لديك . مرفق تكست اسمه (Movi) ثم انقله الى الدرايف (C\windows) ...السبب لو أي شخص حاول أخذ كوبي من الرنامج لا يعمل عنده بدونه . أما لو حابب تلغيها . تفضل أخي المرفق بدونه وايضاًومعه ملف (Movi) . DDAbood-1.rar

طيب خلينا نمشي خطوه خطوه مع بعض بناء على ايه بيتم عرض الدرجة (لأنك ما رديت عليا بخصوص هل هى قيم متغيره ام ثابته) يعنى هنفترض ان المادة الفلانيه درجتها هي 50 فبالتالى القيمه هنا ثابته ولا يمكن ان يكون للعربي كمثال للصف الاول درجه 30 و 50 فى نفس الوقت لهذا الاول نريد ان يكون هناك شروط لتسجيل درجات الطالب نفسها مثل رقم الطالب الذى لا يتغير طول تواجده ارقام الصفوف (يعنى تعمل جدول للصفوف "الصف الاول الثاني ...... وهكذا") ايه تاني ممكن المواد التعليميه ممكن تعطيها كود او رقم خاص بها للتميز مثل لغبه عربيه صف اول يكون له رقم 1 لغه عربيه صف ثاني يكون له رقم 2 وهكذه فبناء الجداول هي اساس اى برنامج اذا كان هذا البناء فيه خلل فان البرنامج سيكون صعب التطوير والتعديل عليه مستقبليا ايضا لابد ان تكون العلاقة بين الجداول وبعض لها علاقة واضحة مثلا علاقة جدول بيانات الطالب بالصفوف ايضا علاقة بيانات الطالب بالمواد المقرره عليه فلما تفكر فى الطريقة التى ستكون العلاقات فيها واضحه هجد كل شئ سهل وسهل التعديل عليه غير لما تعتمد على المعرفات فى العلاقات بين الجداول هيكون سهل تصيد الخطأ وتحييد الخطأ فى الكتابة بالأحرف و المعرفات ارقام والارقام اسهل من الحروف فى التعامل معها لهذا اتركك تفكر فيما قلته لك سابقا وسوف احاول ان اعيد بناء الجداول لتوضيح الفكره التى ذكرتها ايضا برجاء البحث وقراءة جميع المواضيع التى تتحدث عن بناء الجداول والعلاقات فالمنتدي ملئ بالمواضيع العظيمه التى انا شخصيا اتعلمت منها الكثير والترتيب (سائل المولى ان يبارك فى جميع من قام عليها)

تفضل أخي @m.r محاولتي ووافني بالرد . DD425.accdb

حل اخر يغنيك عن كتابة الاكواد في الورقة "الورقة 1" ، ضع أسماء النماذج في العمود A وفي العمود B وقت كل نموذج ، كما هو موضح في المثال التالي: 2) قم بتشغيل هذا الماكرو: 😁 Sub View_User() Dim uForm As Object Dim i As Long Dim MyRng As Variant Dim Nameform As String On Error Resume Next MyRng = Sheets("Sheet1").Range("A2", Sheets("Sheet1").Range("B" & Rows.Count).End(3)) Application.Visible = False For i = 1 To UBound(MyRng) Nameform = MyRng(i, 1) Set uForm = CallByName(UserForms, "Add", VbMethod, Nameform) DoEvents uForm.Show 0 Application.Wait Now + TimeValue("00:00:" & MyRng(i, 2)) DoEvents Unload uForm Next Application.Visible = True On Error GoTo 0 End Sub اليك الملف للفائدة تجربة 4.xlsm

أخي الكريم @m.r ؛ هذه تجربة بسيطة وهي قيد التطوير ,, Move.accdb

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

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

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

اريد اضافه حساب مراكز التكلفه فى دليل الحسابات بشرط يتم الاضافه والحذف كما هو فى دليل الحسابات ويتم الترحيل الى sheet dl2 waleed-2017.xlsm

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

يمكنك مشاهدة هذا البرنامج ACCOUNT SOFTWARE W-COST CENTERS - V1.1.rar

السلام عليكم جزاك الله خيرا أستاذى العزيز جعفر أستاذى العزيز ياسر قمت بتجربة الكود واشتغل معى اوفيس 2010 Cut Copy PseudoEvent by jaafar .rar

الاخت الفاضله شاهدى المرفق شرائح.zip

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

السلام عليكم هذا الكود يمكن ان أسميه فخ أو لغم من المعلوم أن هناك برامج لفك حماية الشيتات لا نستطيع مقاومتها أومنعها من كسر الحماية والمستخدم يقوم بكسر حماية الشيت للحصول على المعلومات السرية داخل البرنامج (معادلات ـ أعمدة مخفية .....الخ) إذا منعنا المستخدم من الحصول على هذه المعلومات السرية فنكون قد حققنا الهدف يبدأ عمل الكود من حدث الصفحة SELLECTION CHANGE ثم ينتقل إلى الإجراء booom وهو يقوم بحذف أوراق محددة عندما يتم فك حماية الورقة (الشيت) والنقر على أي خليه فيها ولكن انتبه : فيمكن أن يكون المبرمج نفسه هو ضحية لهذا الكود (كما حصل لي شخصيا أثناء العمل على هذا المرفق) إذا عاود المبرمج فك حماية الصفحة لتعديل أي معادلة مثلا وتحديد أي خلية سينفجر اللغم وتحذف الأوراق تلقائيا ويقفل البرنامج لذا بعد الانتهاء من عمل أي برنامج وبعد حماية الصفحات يتم وضع هذا الكود فإذا اراد المبرمج في وقت لاحق فك الحماية على الصفحة للتعديل عليها فيجب قبل ذلك الذهاب لمحرر الفيجوال والدخول على الماكرو booom وتعليق السطر الآتي ' Sheets(Array(1, 3, 4)).Delete لأنه المسؤول عن حذف الأوراق (الأولى والثالثة والرابعة) تفضلوا المرفق والشرح داخل الكود abo eed file.rar

السلام عليكم و رحمة الله و بركاته تفضّل أخي الفاضل مثالا على ذلك : التاريخ باسم اليوم الميلادي و الهجري بإمكانك تضيف أو تخذف أو تغير أرقام الليبلات مثلما شئت التاريخ الميلادي و الهجري.rar

اخواني في المنتدى /بعد السلام اقدم لكم نوعاُ جديداً من البحث عن اي قيمة في اي عامود(من اختيارك) و ما يقابلها في عامود اخر (بردو من اختيارك) ما يشبه الدالة Vlookup new vlookup.rar

تم التعديل كما اردت ، وعليك تغيير المدى حسب احتياجك File N Foler2.rar

الحل اخي يعتمد على الاسم دعواتك لمن أبدعه ، وليس لي ، إنه من مقتنياتي File N Foler.rar

:yes: نرجوا الدعاء

السلام عليكم نفس فكرة اخي الفاضل دغيدي مع زيادة توضيح لو اردت ان تتابع المعادلات طبعا وكما أوضح أستاذنا الكريم / جمال دغيدي لابد ان تزيد سهما للأنصبة لكي يكون إجمالي الأنصبة = 29.50 قيراط تفضل حساب ارض زراعية.rar

تكملة لما سبق في التعرف علي الادوات الشائعة لادوات الفورم سوف نتعرف علي بعض الأساسيات الخاصة بالفورم والتي سنستخدمها تباعا اساسيات الفورم.rar

السلام عليكم أخي الحبيب أنت تستخدم أكواد الأستاذ الجليل / عبدالله باقشير كوبي بيست لم أفهم المتغير ah في الكود عموما طلبك اسهل من ذلك كثير أترك زر تفريغ الاسماء (كلير) واضغط الزر الأسود في المرفق 3333-2.rar

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

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