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

تفضل ...... Output_Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Date, "dd-mm-yyyy") & ".xlsx" DoCmd.OutputTo acOutputQuery, "qry_Query", "ExcelWorkbook(*.xlsx)", Output_Path, False, "", , acExportQualityPrint

ماشاء الله لا قوة الا بالله فنااااان و مبدع

وعليكم السلام-دائماً وأبداً لابد من تدعيم اى مشاركة بملف موضح فيه المطلوب بكل دقة...فيمكنك استخراج الرقم 2018 بالمعادلة التالية =LEFT(AD1,LEN(AD1)-FIND("-",AD1)) أما 2019 بالمعادلة التالية =RIGHT(AD1,LEN(AD1)-FIND("-",AD1))

وعليكم السلام ورحمة الله Output_Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Format(Date, "dd-mm-yyyy") & ".xlsx" DoCmd.TransferSpreadsheet acExport, , "qry_Query", Output_Path مع تعديل اسم الاستعلام باسم الجدول المطلوب لديك ...

مادام التقرير يخص موظفا في شهر معين فلا داعي للتقرير ويمكن الاعتماد على عملية التصفية (فلتر) في نفس شيت الشهر مع تعديل المعادلات لتتناسب مع المطلوب . تم ضبط مجموعة المعادلات في خلايا التأخير وما بعدها والتنسيق الشرطي ووضع معادلة ( إجمالي وعدد) الموظف المختار أو الكل حسب الفلتر ويمكن الاستغناء عن صف المجموع أسفل البيانات بالتوفيق حضور وانصراف الموظفين 111.xlsx

افتح الاستعلام في المرفق ثم انقر مزدوجا على رمز الصورة سيظهر لك مربع حوار يمكنك من خلاله حفظ الصورة باسم على حاسوبك اذا نسخت الصورة على حاسوبك يمكنك التعامل معها باحد برامج الرسم Database2.accdb

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

رائع أستاذ @Ali Mohamed Ali ولإثراء الموضوع يمكن جلب الجزء الأول بالمعادلة التالية المختصرة =LEFT(AD1,FIND("-",AD1)-1) بالتوفيق

شكرا جزيلا

ااستاذي الفاضل / محمد صالح اولا نشكر سيادتكم علي الرد والمشاركة ولكن عن تجربة وضعت عدد 2 حدث في الورقة فكان لايعملان مع بعض احدهم يعمل والاخر لا وللتجربة ضع حدث change في الكود واجعله كمثال يعمل علي خلية بها قائمة منسدلة كل ماتتغير هذة القائمة المنسدلة تقوم مثلا بجعل خلاي معينة بها ارقام الي خلايا فارغة واعمل الكود للحدث الثاني actavate لنفس الورقة واجعل هذا الحدث عندما يتم تنشيط الورقة يقوم كود حدث التنشيط بمسح خلايا معينة ستجد ان الحدثين لايعملان معا جرب سيادتك بنفسك وشوف النتيجة في النهاية لايسعني إلا ان اشكر سيادتك ومنتظر الرد

الكود كان يعتمد على تسجيل العربون قبل ذلك ويرحل إلى أول خلية فارغة بعد العمود U على كل حال ومع افتراض خلو العربون تم تحديث الكود السابق وإضافة ميزة الترحيل إلى العمود T & U في حال فراغهم بالتوفيق

جميعا بإدن من الله وفضله

هل تريد ذلك عن طريق المبرمج أم المستخدم هو من يتحكم ؟؟؟؟ اذا كان كمبرمج ..... فيمكن ذلك عن طريق عمل استعلام للجدول المطلوب وتحديد الحقول المطلوبة للتصدير .... ثم تصدير الاستعلام بدل الجدول ... وإذا كان كمستخدم ..... فيمكن ذلك عن طريق عمل فورم يجلب الجداول في كمبوبكس ... ثم اظهار الحقول الخاصة بالجدول بعد اختياره .... ثم تصدير الحقول المختارة فقط ... ماذا تريد انت ؟؟؟؟؟؟؟؟؟

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

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

على افتراض أن الخلية التي بها العدد هي A1 يمكنك استعمال المعادلة التالية =IF(A1<151,0,IF(A1<201,1,2)) بالتوفيق

تمام .. الله يعطيكم العافية جميعاً

جميعا بإذن الله العمود المخفي يحتوي على النطاق المسمى Rng والمستعمل في الكود لاحظ هذا السطر في الكود For I = 1 To Application.CountA([Rng]) بالتوفيق

* بالنسبة لطباعة 10 سجلات فقط يرجع هذا لاعتماد الكود على القيم الموجودة في العمود M المخفي يمكنك إظهار العمود وسحب المعادلة من الخلية M4 إلى الصف 1000 أو حسب أقصى عدد للطلاب * كما يظهر خطأ #N/A بسبب اعتمادك في المعادلات على المدى حتى. العمود J والصواب حتى العمود K كما في حلقة النموذجية جزء التقييم الشهري * كما يجب مطابقة العناوين في الصف 7 مع خلايا العمود C في التقرير ومنها في حلقة النموذجية لا يظهر (مقدار الحفظ بالصفحة ) لأن العنوان مختلف في شيت نموذج إدخال البيانات بالتوفيق

يوجد زر في إذن الصرف والتوريد اسمه (طباعة إذن الصرف / الوارد) أليس هذا هو المطلوب؟!

ربما تجد حلول هنا ..... انظر هنا تفضل >>>>>>

شباب ليش ماكو حل لحد الأن

تفضل هذا التعديل odbExe2.zip

أسعدكم الله وبارك فيكم ،، وهذا خط نسخ منقط راقي من إعداد مجمع الملك فهد لطباعة المصحف بالمدينة المنورة،، KFGQPC-Dot-Font.zip

مالذي تقصده باضافة اصناف؟ لديك صفحة مشروبات وصفحة ماكولات ان كنت تقصد مثلا اضافة صفحة حلويات فطبعا تستطيع ذلك

أهلا بك.. عدل الشفرة التي أشرت إليها لتصبح كالتالي Private Sub crn_DblClick(Cancel As Integer) Dim File_Path As String, File_Name As String, Name_Path As String File_Path = Application.CurrentProject.Path & "\CONTACT\" File_Name = Dir(File_Path & Me.crn & "*.pdf") If File_Name = "" Then MsgBox "لا توجد مستندات محفوظة" Exit Sub End If While File_Name <> "" Name_Path = File_Path & File_Name Application.FollowHyperlink Name_Path File_Name = Dir() Wend End Sub النجمة في سطر المتغير File_Name تعود بأسماء جميع الملفات التي في بدايتها ذات الرقم. راجع ملف التعليمات لمزيد من التوضح حول التابع Dir

لا يوجد مشكلة في إثراء الموضوع ولكن حتى يتم جلب بيانات عمود النسبة تحتاج إلى إضافة سطر وتعديل آخر sh.Cells(m, 8).Value = ws.Cells(r, 12).Value sh.Cells(m, 9).Value = ws.Cells(r, 13).Value For Each x In Array(2, 3, 8, 9) ليصبح الكود كاملا Sub Test() Dim x, ws As Worksheet, sh As Worksheet, r As Long, m As Long, c As Long, n As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") Set sh = ThisWorkbook.Worksheets("2") With sh.Range("B2").CurrentRegion.Offset(1) .Cells.UnMerge: .ClearContents End With m = 3 For r = 4 To ws.Cells(Rows.Count, "B").End(xlUp).Row sh.Cells(m, 2).Resize(, 2).Value = ws.Cells(r, 2).Resize(, 2).Value n = 4 For c = 4 To 10 Step 2 sh.Cells(m, n).Value = ws.Cells(r, c).Value sh.Cells(m + 1, n).Value = ws.Cells(r, c + 1).Value n = n + 1 Next c sh.Cells(m, 8).Value = ws.Cells(r, 12).Value sh.Cells(m, 9).Value = ws.Cells(r, 13).Value For Each x In Array(2, 3, 8, 9) sh.Cells(m, x).Resize(2).Merge Next x m = m + 2 Next r Application.ScreenUpdating = True End Sub بالتوفيق

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

Sub Test() Dim x, ws As Worksheet, sh As Worksheet, r As Long, m As Long, c As Long, n As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("Sheet1") Set sh = ThisWorkbook.Worksheets("2") With sh.Range("B2").CurrentRegion.Offset(1) .Cells.UnMerge: .ClearContents End With m = 3 For r = 4 To ws.Cells(Rows.Count, "B").End(xlUp).Row sh.Cells(m, 2).Resize(, 2).Value = ws.Cells(r, 2).Resize(, 2).Value n = 4 For c = 4 To 10 Step 2 sh.Cells(m, n).Value = ws.Cells(r, c).Value sh.Cells(m + 1, n).Value = ws.Cells(r, c + 1).Value n = n + 1 Next c sh.Cells(m, 8).Value = ws.Cells(r, 12).Value For Each x In Array(2, 3, 8) sh.Cells(m, x).Resize(2).Merge Next x m = m + 2 Next r Application.ScreenUpdating = True End Sub

هل معنى أن امتداد الملف xlsx أنك تريد تنفيذ المطلوب بالمعادلات؟

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

روائع تحفظ من المبدع استاذىد.كاف يار تسلم ايدك والله احترام من القلب

لقد قمت بتصميم برنامج للسلف اتمنى ان يكون هذا طلبك انت فقط عدل التصميم بما يتناسب معك مميزات البرنامج :- 1- اضافة للموظفين 2- اضافة سلف لهم وتحديد عدد الاقساط وتاريخ بداية القسط 3- استعراض السلف المستحقه فى هذا الشهر والاشهر السابقه 4-استعراض ما تم دفعه 5-استعراض السلف المتبقة لكل موظف ملف التحميل بالمرفقات برنامج السلف (عمر ضاحي).accdb

بالنسبة للمطلوب الأول تحتاج فقط لملاءمة الطباعة في صفحة واحدة فقط وأسهل طريق لها في نافذة معاينة قبل الطباعة أو من اعداد الصفحة وبالنسبة للأرقام فهي فعلا يتم جلبها لصفحة الطباعة تلقائيا بسبب وجود معادلات البحث وبالنسبة للتاريخ في صفحة الطباعة فهو مضبوط وإذا كنت تقصد في صفحة إدخال البيانات فاستعمل في خلية اليوم =TEXT(TODAY(),"b2dd") وفي خلية الشهر =TEXT(TODAY(),"b2mm") وفي خلية العام =TEXT(TODAY(),"b2yyyy") بالتوفيق

بالخدمة استاذ ورحم الله والديك تفضل التعديل الخاص بعدد السجلات التي سيتم نقلها ملاحظة : الكود منقول للامانة مع بعض التعديلات و يرجى التاكد من فاعليته Access-Import-2.rar

لا أدري إن كان المقصود ب حفظها كملف pdf أن لكل طالب ملفا أم طباعة جميع التقارير في ملف pdf واحد على العموم قام أخي @د.كاف ياربالمقصود الأول وهذا الاحتمال الثاني طباعة جميع التقارير في ملف واحد باسم محتوى الخلية H1 للعلم تم تعديل معادلة البحث للاعتماد على رقم المسلسل لجلب بيانات الطالب نكتب مسلسله في الخلية F1 بالتوفيق تقرير الطلاب pdf.xlsm

بعد اذن الاخ محمد عمليات الــــ Copy و الـــ Paste ترهق البرنامج دون اي فائدة (قدر الامكان الابتعاد عتها خاصة في حالة البيانات الكثيرة) Sub Distrebute_data() Dim lr As Long, M As Long Dim Sh As Worksheet, i%, x%, But_Sheet$ Dim AAM As Worksheet Set AAM = Sheets("عام") lr = AAM.Cells(Rows.Count, "A").End(xlUp).Row If lr < 3 Then Exit Sub i = 3 Do Until i = lr + 1 On Error Resume Next But_Sheet = AAM.Cells(i, "G") Set Sh = Sheets(But_Sheet) If Err.Number = 0 Then x = Sh.Cells(Rows.Count, "A").End(xlUp).Row + 1 Sh.Cells(x, 1).Resize(, 9).Value = _ AAM.Cells(i, "a").Resize(, 9).Value End If Error.Clear i = i + 1 Loop AAM.Cells(3, 1).Resize(lr, 9).ClearContents End Sub

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

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

تفضل Private Sub CommandButton6_Click() Select Case ComboBox1.Value Case "بحث في الاسماء" ListBox1.Clear For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i If TextBox1 = "" Then Exit Sub Sheets("Sheet1").Activate ss = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row j = 0 For Each C In Range("a2:a" & ss) If C Like TextBox1.Value & "*" Then ListBox1.AddItem ListBox1.List(j, 0) = Cells(C.Row, 1).Value ListBox1.List(j, 1) = Cells(C.Row, 2).Value ListBox1.List(j, 2) = Cells(C.Row, 3).Value j = j + 1 End If Next C Case "بحث في الرقم القومي" ListBox1.Clear For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i If TextBox1 = "" Then Exit Sub Sheets("Sheet1").Activate ss = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row j = 0 For Each C In Range("c2:c" & ss) If C Like TextBox1.Value & "*" Then ListBox1.AddItem ListBox1.List(j, 0) = Cells(C.Row, 1).Value ListBox1.List(j, 1) = Cells(C.Row, 3).Value j = j + 1 End If Next C Case "بحث في تاريخ الميلاد" ListBox1.Clear For i = 1 To 12 Controls("textbox" & i + 1).Value = "" On Error Resume Next Next i If TextBox1 = "" Then Exit Sub Sheets("Sheet1").Activate ss = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row j = 0 For Each C In Range("b2:b" & ss) If C Like TextBox1.Value & "*" Then ListBox1.AddItem ListBox1.List(j, 0) = Cells(C.Row, 1).Value ListBox1.List(j, 1) = Cells(C.Row, 2).Value j = j + 1 End If Next C End Select End Sub 1- 2- 3- project.xlsm

السلام عليكم ورحمة الله وبركاته الاساتذة العظام خبراء المنتدى الكرام بارك الله فيكم لما تقومون به من جهد وعطاء غير محدود لكل أعضاء المنتدى و زائريه وفتح الله عليكم من علمه وجعله فى ميزان حسناتكم وغفر لكم ولوالديكم اجمعين الملفين المرفقين قمت بتحمليهم من هذا المنتدى الرائع والخاصين بمواضيع الخبراء الكبار بالمنتدى وسع الله عليهم اجمعين هذا هو الموضوع الاول والذى قمت بتنزيل ملف الحماية منه وهذه هى المشاركة التى قمت بتحميل الملف الاول منها لا اريد اطول كثير لاني زعيف في اللغة العربية لذلك اليكم قاعدة مع الكراك حماية.rar كراك.rar والموضوع الثانى هو وقمت بتحميل الملف من هذه المشاركة لقد قمت بإضافة الملاحظات التي أشار إليها الإخوة إلى البرنامج و هي كالتالي: 1- ملاحظة الأستاذ @Shivan Rekany التي تخص مشكلة تقديم التاريخ قمت بالتعديل على المرفق بحيث إذا كانت المدة بين تاريخ اليوم و آخر إستعمال للبرنامج أكبر من 7 أيام يظهر البرنامج رسالة للتأكد من أن تاريخ الجهاز صحيح. 2- ملاحظة الأستاذ @sandanet التي تخص عدم التفعيل إذا كان البرنامج مفعل. الآن أصبح البرنامج يرفض التفعيل إذا كانت المدة المتبقية أكبر من 15 يوما. 3- ملاحظة الأخ @Aliko في ما يخص استعمال رقم الهارديسك. رقم النسخة الآن غير ثابت فهو يتغير من جهاز إلى آخر حسب رقم الهارديسك. و هذا هو المرفق:‫‫فترة تجريبية2003.rar ‫‫فترة تجريبية.rar بالنسبة للاشخاص الذين قاموا باستعمال المرفقات الموجودة في المشاركات السابقة عليهم بتشغيل البرنامج الموجود في هذا المرفق من أجل مسح جميع البيانات السابقة من الرجستري و البدء من جديد. حذف المجلدات من الرجستري.rar __________________________ وما اريده هو ان يتم دمج الملفين معا ليصبح حماية من ناحية عدم نقل البرنامج من جهاز لاخر وفى نفس الوقت حمايته بفترة محددة يلزم بعدها طلب التفعيل من صاحب البرنامج حيث اننى اريد دمج ملف الفترة التجريبية فى ملف الحماية اى اريد فقط من ملف الفترة التجريبية كود الوقت ودمجه فى ملف الحماية اى اريد الملفات كلها التى فى برنامج الحماية وفقط ما يلزم من برنامج الفترة التجريبية لدمجه مع برنامج الحماية ويصبحوا برنامج واحد أى ساخذ الملفات الثلاثة من برنامج الحماية الجدول والنموذج والوحدة النمطية واريد أن يكون معه وحدة الفترة التجريبية سواء مدمجة أو منفصلة حسب ما ترونه افضل ...... مع العلم أنه بتجربة برنامج الفترة التجريبية وجد انه يقوم كل مرة بالسؤال عن التفعيل واظهار رسائل كثيرة ومن الافضل انه بعد ان يتم التفعيل لاول مرة تختفى الرسائل ولا تظهر الا قبل ان تنتهى المدة التجريبية باسبوع مثلا واعرف ان طلبى بسيط جدا بالنسبة للخبراء المحترفين القائمين على تلك البرامج المفيدة @Shivan Rekany @صالح حمادي @sandanet @Aliko @ابوخليل @ديو05 @kanory ‫‫فترة تجريبية.rar حماية.rar

عفوا هذا المرفق نسخة تجريبية بواسطة الربط مع الريجستري.rar

أشكر كل من قام بالمشاركة في هذا الموضوع ولكن استوقفني شيء يسير جداً ألا وهو المدة بين آخر رد في 23 أكتوبر 2009 ورد استاذنا خالد القدس بتاريخ أمس 6 أكتوبر 2011 وهذا يعني أن منتدانا به الكثيييير ولكننا لا نستعمل البحث جيداً وأنا أولكم فقد وقعت في هذا الأمر قبل ذلك مما جعلني أجذب انتباه الإخوة إلى هذه الملاحظة وفقنا الله وإياكم لكل ما يحب ويرضى

الحمد لله الذي هدانا لهذا وما كنا لنهتدي لولا أن هدانا الله

أشكر لك مرورك الكريم أخي قطان نفعنا الله وإياكم بما علمنا وعلمنا ما ينفعنا

يمكنك استعمال هذا الكود Private Sub Workbook_Open() MsgBox "اكتب هنا نص الرسالة الذي تريده" End Sub

يا أخي استعملنا التحقق من الصحة للتأكد من مدخلات المستخدم حتى لا يكتب مثلا 1/6 هكذا 6/1 ولا يمكنك استعمال شرطين للتحقق من صحة المدخلات وأعتقد أن تلوين الفصول المكررة باللون الأحمر كافي جدا لجذب انتباه المستخدم لتصحيح هذا الخطأ

تفضل أخي الكريم يتم تنفيذ الكود في تمام التاسعة صباحا يمكنك تغيير وقت جهازك إلى 8:59 ص ثم افتح الملف وانتظر دقيقة الكود قائم على اختبار الوقت الحالي للجهاز هل هو 9:00 فإذا كان كذلك يتم تنفيذ الكود وإذا لم يكن كذلك يعيد الكرة كل دقيقة وأي استفسار لا تتردد أخوك محمد صالح في خدمتك Mas-ontime.rar

أخي الكريم ليس هذا النوع من القوائم هو الذي ينبغي استخدامه وإنما يمكنك استخدام التحقق من الصحة لعمل قائمة الفصول واستخدام التنسيق الشرطي لتلوين التكرار وهذا ما تم تعديله في مرفقك في العمود الأول فقط يمكنك تكراره في باقي الأعمدة mas-table.rar

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