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

تفضل ...... 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) بالتوفيق

اتضح بعد جهد جاهد أن هناك مكافح فيروسات اسمه Rav كان ماسك ملفات pdf وحذفته وعمل الملف بالشكل الصحيح،،

اخي لايجوز جعل القيم للاوزان المختلفة في حقل واحد عملت لك الجدول المطلوب ... قم بعمل نموذح فرعي له واستبدله بالموجود لديك 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

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

أهلا بك.. عدل الشفرة التي أشرت إليها لتصبح كالتالي 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

الدالة صحيحة بلا أي مشاكل وظيفتها جمع الأرقام من مدى به نصوص وأرقام بينهما مسافة ربما يكون الخطأ في وضع أول سطر من الدالة بجوار التعريف بها حيث أن الترتيب الصحيح هكذا Function SumNumOnly(rngS As Range, Optional strDelim As String = " ") As Double Dim xNums As Variant, lngNum As Long xNums = Split(rngS, strDelim) For lngNum = LBound(xNums) To UBound(xNums) SumNumOnly = SumNumOnly + Val(xNums(lngNum)) Next lngNum End Function بالتوفيق

لا يوجد مشكلة في إثراء الموضوع ولكن حتى يتم جلب بيانات عمود النسبة تحتاج إلى إضافة سطر وتعديل آخر 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

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

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

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

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

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

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

السلام عليكم ورحمة الله وبركاته على الرغبة السيد @محمد عبد الشفيع من هنا https://www.officena.net/ib/topic/86775-دمج-برنامج-الحماية-مع-برنامج-الفترة-التجريبية تم فتح هذا الموضوع و ان شاء الله ساشرح خطوة خطوة حسب وقتي حتى اخلص من الموضوع وفي النهاية راح اسمع اراء و مقترحاتكم والان نحن نحتاج جدول واحد لكي نحفظ فيه تسلسل و رقم هارد و المعالج و رقم التفعيل البرامج و مدة التفعيل و تاريخ التفعيل و تاريخ اخر مرة فتح البرامج وسنسمي هكذا بالتسلسل كما مبينة في الصورة ID من نوع ترقیم تلقائی NumForMoaalic من نوع نصي NumForHard من نوع نصي NumTascil من نوع نصي Midda من نوع رقم و مصدره يكون عمودين واحد لكتابة رقم ايا عدد ايام التفعيل والاخر لكتابة مثلا يوم واحد او اسبوع واحد هكذا وهذا هو مصدره "1";"يوم واحد";"7";"اسبوع واحد";"30";"شهر واحد";"90";"ثلاث اشهر";"180";"ستة اشهر";"365";"سنة واحدة";"18250";"مدى الحياة" شوف الصورة لكي نعرف خصائص هذا الحقل جيداً و ايضا عندنا حقل باسم firstdate من نوع وقت والتاريخ واخر حقل هو EndDate من نوع وقت والتاريخ وتم تسمية الجدول باسم TblTascil ولان ليس لدي وقت اليوم ان اكون على جهاز لابتوب غدا او يوم السبت ان شاء الله راح اكمل الشرح ونبدأ بعمل النماذج والسلام عليكم ورحمة الله وبركاته

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

بعد اذن الاخ محمد عمليات الــــ 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 وهذا يعني أن منتدانا به الكثيييير ولكننا لا نستعمل البحث جيداً وأنا أولكم فقد وقعت في هذا الأمر قبل ذلك مما جعلني أجذب انتباه الإخوة إلى هذه الملاحظة وفقنا الله وإياكم لكل ما يحب ويرضى

أخي الكريم أحمد كلمة مرور قاعدة البيانات check هي : اجعل لغة الكتابة عربي ثم اضغط على حروف كلمة check ستجد أنها ؤاثؤن وتقبل تحياتي أخوك محمد صالح وأقترح على الإخوة المشرفين نقل الموضوع إلى منتدى الأكسس

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

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

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

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

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

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

لايوجد مرفق أين المرفق ؟؟

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