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

تفضل 🙂 1551.Relink.zip

CurrentDb.Properties("StartUpForm")="myForm"

بعد التعديل حسب طلبك. التكرار في اللجان_03.xlsm

كنت مستغرب من ابو البشر يسأل هذا السؤال البسيط ، والآن عرفنا السبب 😁 هل انت متأكد ان اسم النموذج "Form.frm-UserLogon" وليس "Form.frm_UserLogon" او "frm-UserLogon" او "frm_UserLogon" شوف اسم النموذج اذا صحيح

تفضل <>><>< هههههه Relink.rar

انا استعمل Macro اسمه Autoexec والذي معناه انه اول شيء يشتغل عند فتح الاكسس ، وفيها اضع اسم النموذج الذي اريد فتحه ، او الدالة في الوحدة النمطية اللي اريدها تشتغل 🙂 جعفر

السلام عليكم حسب فهمي للموضوع عملت لك بحث في كل الحقول سواء كان في بداية الكلمة او في نهايتها مع معاينة التقرير والذي يمكن طباعته تحياتي العمال.accdb

سأحاول الليلة إن شاء الله فإن وفقت في الحل رفعته لك. مع المعذرة .. حققت لك جزء من طلبك واسمح لي بالتوقف عند هذه النقطة موفقين. التكرار في اللجان_04.xlsm

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

وهنا أيضا قمت بعمل كود لإضافة السجلات وترقيمها 🙂 وهذا هو الكود : Sub Add_2000_Record() Dim x As Long For x = 1 To 2000 CurrentDb.Execute "INSERT INTO Ta1 ( IDD ) VALUES (" & x & ");" Next End Sub إضافة2000سجل.rar

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

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

أخي مصطفى .. الأكسس يقدم لك طرق سهلة لاستيراد البيانات من مصادر خارجية كالأكسل أو قاعدة أكسس أخرى أو قواعد البيانات الأخرى .. وسائل غير النسخ واللصق 🙂 وكان سؤال المهندس جعفر عن مكان تخزين بيانات هؤلاء ال 2000 موظف لينطلق بك وبنا إلى الوسائل السهلة لاستيراد هذه البيانات لبرنامجك .. 🙂

Generate PDF Dahy VBA Skills fun موضوعنا النهاردة موضوع شيق مدخل للدرس الثالث للفورم التفاعلي وفي نفس الوقت ها نتعرف فيه علي أدوات ها توفر الوقت والمجهود لشريحة كبيرة تستخدم قالب معين مثل الموارد البشرية لما ترسل طلبات التوظيف المالية لمطابقات كشوف الحساب للموردين واحنا داخلين علي موسم الجرد الختامي والبنوك او الشركات او المواقع التي ترسل رسائل دورية وما الي ذلك انا اخترت المثال علي شئون الموظفين وطلبات التوظيف وهانتعرف علي كيفية التعديل علي النموذج Word عن طريق الفورم عناصر الدرس ملف Templet word القالب المستخدم اداة Microsoft Outlook 16.0 Object Library أداة Microsoft Word 16.0 Object Library ونتعلم مع بعض VBA Dynamic Code وكيفية عمل ملف PDF وارساله بالايميل الشرح نقوم بإضافة الأدوات في الفيجوال كما يلي من Tools نختار References Microsoft Outlook 16.0 Object Library اضافة أداة Microsoft Word 16.0 Object Library تحديد مسار القالب كما يلي شفت + كليك يمين علي ملف الوورد ثم نختار Copy as Path حسب موقع الملف علي جهازك انا عندي في برتيشن F "\F:\GeneratePDF\Template_Contract.docx" تحديد مسار حفظ ملفات PDF الذي يحفظها البرنامج F:\Generate and Preview طبعا يلي مش عارف يغير في الكود يقوم بحفظ الملف المرفق علي برتيشين الFبعد فك الضغط مباشرة . ملف الورد يلي نستخدمه كقالب ولاحظ المسميات يلي انت ظللتها بالاصفر نفس مسميات الليبل ف الفورم وضعتها بين علامتي ##لانها بيانات متغيرة سيتم اضافاتها من الفورم لاحظ معي عند استدعاء الملف بالورد شاهد النتيجة البرنامج اضاف البيانات المظلله بشكل تلقائي الوظيفة الثانية للبرنامج اني ببعت الملف بالايميل من البرنامج لتوفير الوقت والوظيفة في حالة التقارير الدورية او النشرات او حسب استخدام الفرد الذي يحتاج ارسال عدد كبير في نفس الوقت مع ملاحظة انه بشكل تلقائي بياخد الايميل من الفورم ويضيف اسم الموضوع والمرفقات كما بالكود بشكل تلقائي طبعا الشرح موجز لاهم العناصر انا برفق مع الشرح مثال عملي منه للشرح ومنه نستفيد منه او من الافكار يلي فيه وبكون منتظر حد يسال عن اي شئ داخل الملف بصدر رحب لكن للاسف كعادتنا نحفظ في الارشيف علي اية حال الملف بالمرفقات واي استفسار لا تترد كلنا بنتعلم مع بعض شارك وتفاعل انت تسال وذلك يسال واخر يجيب وكلنا هانستفيد الدرس القادم ان شاء الله هاشرح الاكواد ونتعرف علي كود الحغظ والتعديل والبحث الديناميكي لضمان عمل الملف اتبع الشرح السابق في اضافة الادوات ومسار الملف وبالتوفيق للجميع ولا تنسونا من دعائكم بظهر الغيب بصلاح الحال GeneratePDF.rar

من تجربتي في الرابط المرفق ، لم استعمل كلمة Form في اسم النموذج . احذفه وجرب ، ووهل جربت تفتح البرنامج مباشرة ، فهل يشتغل دون اخطاء ؟

كنت ولازلت انسان اتعلم وبسيط لا ارتقى الى شريف علمكم بارك الله فيك 😉 نعم لان البرنامج كان يعمل ... ولازال يعمل على اوفيس 2007 ويندوز 7 جهازي حاليا :: ويندوز 10 64Bit اوفيس 19

تفضل 🙂 1553.Database1.accdb.zip

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

جزاك الله اخي @ازهر عبد العزيز اريدة بالكود ..... ليتم تعديله بدون اللجوء لشاشة الخصائص

Try this code Sub Test() ExportAsPDF "Cards" End Sub Public Sub ExportAsPDF(ByVal sOut As String) Dim ws As Worksheet, s As String For Each ws In ThisWorkbook.Worksheets If InStr(ws.Name, Chr(199) & Chr(225) & Chr(200) & Chr(216) & Chr(199) & Chr(222) & Chr(201)) Then s = s & IIf(s <> Empty, ",", Empty) & ws.Name Next ws PrintToPDF Split(s, ","), ThisWorkbook.Path & "\" & sOut & ".pdf" End Sub Public Sub PrintToPDF(arr, sFileName As String, Optional vQuality = xlQualityStandard, Optional vIncDocProperties = True, Optional vIgnorePrintAreas = False, Optional vOpenAferPublish = False) ThisWorkbook.Sheets(arr).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, Quality:=vQuality, IncludeDocProperties:=vIncDocProperties, IgnorePrintAreas:=vIgnorePrintAreas, OpenAfterPublish:=vOpenAferPublish ActiveSheet.Select End Sub

بالاضافة لما تفضل به الاستاذ @kkhalifa1960 جزاه الله خيرا اليك مشاركتي Option Compare Database Option Explicit Dim strSQL As String Dim rs As DAO.Recordset Private Sub CmdClear_Click() Me.TEXT_CHERCHE = "" Me.Query_no_subform.Form.Filter = "" Me.Query_no_subform.Form.FilterOn = False End Sub Private Sub TEXT_CHERCHE_Change() strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34) Me.Query_no_subform.Form.Filter = strSQL Me.Query_no_subform.Form.FilterOn = True Set rs = Me.Query_no_subform.Form.Recordset If (rs.RecordCount <> 0) Then rs.MoveFirst Do Until rs.EOF rs.Edit rs![oui/non] = True ' change "chkBoxFieldName" with the actual name of your checkbox field rs![date_à_regler] = Date ' change "dateFieldName" with the actual name of your date field rs.Update rs.MoveNext Loop Else MsgBox "السجل المطلوب تم التحقق منه سابقا بتاريخ " End If End Sub Private Sub cmdPrintPreview_Click() Me.TEXT_CHERCHE.SetFocus strSQL = "numéro_coud LIKE " & Chr(34) & Me.TEXT_CHERCHE.Text & "*" & Chr(34) ' Open the report in print preview mode DoCmd.OpenReport "MyReport", acViewPreview, , strSQL End Sub وهذا ملفك بعد التعديل. هل هو المطلوب؟ بالتوفيق my PR.accdb

شكرا ابو احمد على المعلومة ، واتضح ان Int يصلح كذلك 🙂 int([DateTime]) او fix([DateTime])

هل ممكن ان ترفق ملفك حتى نرى اين المشكلة ؟ وجرب هذا التعديل Private Sub Form_Load() Dim OldLong As Long Dim nodX As Node Set nodX = TreeView1.Nodes.ADD(, , "R", "أعدادات النظام", 3) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C1", "بيانات الشركة", 2) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C2", "بيانات مستخدمي النظام", 5) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C3", "كلمات المرور", 1) Set nodX = TreeView1.Nodes.ADD("R", tvwChild, "C4", "بيانات المطورين", 4) nodX.EnsureVisible OldLong = GetWindowLong(TreeView1.hwnd, GWL_EXSTYLE) SetWindowLong TreeView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL InvalidateRect hwnd, 0, False Dim formsDictionary As New Scripting.Dictionary formsDictionary.ADD ChrW(&H62A), "frmCompany" formsDictionary.ADD ChrW(&H622), "frmSystemUserData" formsDictionary.ADD ChrW(&H643), "frmPassword" formsDictionary.ADD ChrW(&H62C), "frmDeveloper" End Sub Private Sub TreeView1_Click() Dim strFormName As String Dim formsDictionary As New Scripting.Dictionary formsDictionary.ADD "بيانات الشركة", "frmCompany" formsDictionary.ADD "بيانات مستخدمي النظام", "frmSystemUserData" formsDictionary.ADD "كلمات المرور", "frmPassword" formsDictionary.ADD "بيانات المطورين", "frmDeveloper" strFormName = TreeView1.SelectedItem.Text If formsDictionary.Exists(strFormName) Then DoCmd.OpenForm formsDictionary(strFormName) Else MsgBox "عذرا هذا النموذج غير موجود", vbExclamation, "تنبيه" End If End Sub ولك بمثل ما دعوت أخي الدكتور محمد تحياتي

ويمكن استحصال التاريخ فقط باستخدام دالة Fix أيضا.

السلام عليكم ورحمه الله وبركاته مشاركه مع اخوانى واساتذتى افتح النموذج frmleave واطلع على مصدر السسجلات بعدالتعديل zofdate: werEjaza(Nz([strdate];#01/01/1900#);Nz([enddate];#01/01/1900#)) بالتوفيق fmmm2.accdb

وعليكم السلام 🙂 تفضل جعفر

إذا هذا هو الشهر الذي نبحث عنه استاذنا @ابوخليل وانا - واعوذ بالله من كلمة انا- اتيت بها يا رجل - جزاك الله خيرا

الحقيقة العملية معقدة وصعب عملها بالتنسيق الشرطي. سأقوم ابتداءً بعمل كود يبحث عن التكرار ويتوقف مع أول تكرار حتى تقوم بتصحيح التكرار ثم تبحث من جديد.

تفضل أخي ووافني بالرد 1585909217_myPR-1.accdb

وطريقة اخرى للنسخ واللصق ، في الاكسل مثلا ، نظم الحقول بنفس ترتيب الحقول في الاكسس ، او في الاكسس نظم الحقول بنفس ترتيبها في الاكسل (يعني امسك الحقل و خليه يزحف يمين ويسار) ، ومو لازم جميع الحقول تكون متساوية في الاكسل والاكسس ، في الاكسل اعمل نسخ للاعمدة المطلوبة ، وفي الاكسس اختار في سجل جديد (مكان وجود النجمة) ، ثم اختار الحقول المتسلسلة من الاكسس (يعني مو كل الحقول) ، ثم الصق 🙂 وعلشان ترتيب الحقول في الجدول ما تخترب عليك ، اغلق الجدول بدون ان تعمل له حفظ : . جعفر

وعليكم السلام ورحمة الله تفضلtest.xlsm

تم حذف السطر الاول من ملف الاكسس بواسطة كود من الاكسس وهذا هو الكود. Sub DeleteFirstRow() Dim xlApp As Excel.Application Set xlApp = New Excel.Application Dim xlWorkbook As Excel.Workbook Set xlWorkbook = xlApp.Workbooks.Open("C:\xxxxx\0125.xls")غير مسار الملف xlWorkbook.Sheets(1).Activate Dim firstRow As Excel.Range Set firstRow = xlApp.ActiveSheet.Range("A1:IV1") firstRow.Delete xlWorkbook.Save xlWorkbook.Close xlApp.Quit End Sub بالتوفيق

السلام عليكم 🙂 اخوي ابو البشر ، الافضل ان تحذف الرابط الحالي قبل ان تعمل رابط جديد ، وتتعامل مع النسخة xlsx 🙂 If tdf.Name = "shet_Data" Then Call CurrentDb.TableDefs.Delete(tdf.Name) DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel12Xml, _ "shet_Data", CurrentProject.Path & "\Data.xlsx", True, "ورقة1$" End If جعفر

السلام عليكم ورحمه الله وبركاته وبها نبدأ 1- مرحبا بك في المتتدي وفي المشاركه الاولي لك في المنتدي 2- هذا الموضوع يخالف قواعد المنتدي 3- ان كان باسوورد فتح الملف من الصعب معرفته

وعليكم السلام ورحمة الله لاتنتظر مساعده دون ارسال ملف مدعوم بشرح

طيب جرب كده .................. Relink.rar

عليكم السلام ورحمة الله وبركاته تفضل أخي الكريم Sub test() With Sheets("يومية الحضور والإنصراف").Range("B4:C" & Sheets("يومية الحضور والإنصراف").Cells(Rows.Count, 1).End(xlUp).Row) .Formula = "=IFERROR(VLOOKUP($A:$A,Table9,COLUMN(),0),"""")" .Value = .Value End With With Sheets("رصيد الأجازات").Range("B3:D" & Sheets("رصيد الأجازات").Cells(Rows.Count, 2).End(xlUp).Row) .Formula = "=IFERROR(VLOOKUP($A:$A,Table9,COLUMN(),0),"""")" .Offset(, 3).Resize(, 1).Formula = "=IFERROR(IF(DATEDIF([@[تاريخ التعيين]],$D$1,""D"")/30>3.1,""يستحق"",""""),"""")" .Offset(, 5).Resize(, 1).Formula = "=IF([@[معادلة الرصيد]]=""يستحق"",$O$1+[@[معالجة الرصيد]],0)" .Offset(, 6).Resize(, 1).Formula = "=[@[الرصيد المرحل]]+[@[رصيد 2023]]" .Offset(, 7).Resize(, 1).Formula = "=(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A3,'يومية الحضور والإنصراف'!$H:$H,""أجازة"")+(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A3,'يومية الحضور والإنصراف'!$H:$H,""أجازة مجمعة"")))" .Offset(, 8).Resize(, 1).Formula = "=(COUNTIFS('يومية الحضور والإنصراف'!$A:$A,$A4,'يومية الحضور والإنصراف'!$H:$H,""أجازة عارضة""))" .Offset(, 9).Resize(, 1).Formula = "=IF(E3=""يستحق"",$N$1-[@[ عارضة]],0)" .Offset(, 10).Resize(, 1).Formula = "=(([@[إجمالي الرصيد المستحق]]-([@[ سنوي]]+[@[ عارضة]]+[@[تسوية نقدي]])))-[@[باقي رصيد العارضة]]" .Offset(, 11).Resize(, 1).Formula = "=([@[باقي رصيد السنوي ]]+[@[باقي رصيد العارضة]])" With .Resize(, 12) .Value = .Value End With End With End Sub

@saad 77 @saad alyousif @فوزى فوزى @مصطفى محمود مصطفى @mohameddeela @فارس حسن3

وعليكم السلام ورحمة الله تعالى وبركاته تقضل استاد فوزي ربما هدا ما تقصد Const MyWidth As Single = 80 Const MyHight As Single = 20 Private Sub TEST1() Dim WS As Range Dim Lf As Double, Tp As Double Dim ContColmn As Integer, r As Integer, c As Integer Set WS = Range("A3:I17") ContColmn = WS.Columns.Count For r = 1 To WS.Rows.Count l = 0 Lf = Me.Frame1.Width - 100 For c = 1 To ContColmn Lf = Lf - WS.Columns(c).Width With Me.Frame1.Controls.Add("Forms.Label.1") .BorderStyle = 1 .Move Lf, Tp, MyWidth, MyHight .Width = WS.Columns(c).Width Call TEST(.Name, WS.Cells(r, c)) End With Next Tp = Tp + MyHight c = 0 Next Set X = Nothing End Sub Private Sub TEST(iName As String, MyCel As Range) With Me.Controls(iName) .BackColor = MyCel.Interior.Color .Caption = MyCel.Text .TextAlign = 2 With .Font .Name = MyCel.Font.Name .Bold = True .Size = MyCel.Font.Size End With End With End Sub Private Sub UserForm_Initialize() Me.Frame1.SpecialEffect = 0 TEST1 End Sub عرض النتائج فى الفورم_1.xlsm

السلام عليكم الخلل كان في تنسيقات الصفحة (ناحية الطباعة-تحجيم الصفحة-فاصل الصفحات..) وقد تم تعديلها... الملف.rar

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

بعد اذن استاذنا الفاضل والقدير الاستاذ ضاحى ورغبة استاذى gamalin وطلبه للملف استاذن من الاستاذ ضاحى غريب ان اعطيه الملف بعد ما اصبح يعمل معى ZAD IPTV Subscription.xlsm

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

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

تفضل EXEMPLE.xlsm

المرفق به فورم يحتوي على عدد 2 ليست بوكس احدهما لجلب اسماء الاوراق الموجودة في ملف الاكسيل يوجد ازرار تمكنك من ترحيل اسماء الاوراق التي تريد طباعتها او حفظها إلى الليست بوكس الاخر ومن ثم الضغط على زر الطباعة او الحفظ يمكنك اكتشاف الامر عمليا حمل المرفق وشاهد Print and Save As pdf Using ListBox in a UserForm.rar

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

السلام عليكم اعداد تقرير من نطاق معين اتوماتيكيا عن طريق فورم لاختيار رؤوس الاعمدة التي تريده في التقرير ما عليك سوى تغيير اسم الورقة والعمود الذي يعين آخر صف في النطاق والنطاق هنا: Private Sub kh_MyRngSet() Dim Last As Long '======================== ' تعيين النطاق ويشمل رؤوس الاعمدة With Sheets("قاعدة البيانات") Last = .Range("C" & .Rows.Count).End(xlUp).Row Set MyRng = .Range("A2:Z" & Last) End With '======================== Num = MyRng.Columns.Count End Sub وتعيين اول صف في ورقة التقرير هنا: '======================== ' اول صف للتقرير Const iRow As Integer = 3 '======================== خبور خير اعداد تقرير حسب اختيار الاعمدة اتوماتيكيا.rar

اخى الفاضل اذهب الى ملف File خيارات Options خيارات متقدمة Advanced وانزل قليلا للاسفل وتأكد من وجود علامة صح بجانب اظهار كافة النوافذ في شريط المهام Show All Windows In Taskbar .. ان لم تكن موجودة قم بوضعها كما في الصورة المرفقة .. جرب واعلمنا بالنتيجة تحياتي

السلام عليكم الشكر واصل لاخي ابوحنين تم فرز البيانات حسب عمود الاسم بعد مسح الخلايا التي لا توجد فيها معادلات Sub trheel() Dim cel As Range Dim Lr As Long, Lrr As Long, R As Long, i As Long, iCont As Long With Sheets("البيانات") Lr = .Cells(Rows.Count, "B").End(xlUp).Row iCont = WorksheetFunction.Max(.Range("A3").Resize(Lr)) Lrr = Cells(Rows.Count, "D").End(xlUp).Row For R = 3 To Lrr If Cells(R, "O").Value = "ناجح" Then i = i + 1 .Cells(Lr + i, "A").Value = iCont + i .Cells(Lr + i, "B").Resize(1, 13).Value = Cells(R, "B").Resize(1, 13).Value .Cells(Lr + i, "O").Value = [I1] .Cells(Lr + i, "P").Value = [M1] If cel Is Nothing Then Set cel = Cells(R, "A").Resize(1, 13) Else Set cel = Union(cel, Cells(R, "A").Resize(1, 13)) End If Next End With If i Then On Error Resume Next cel.SpecialCells(xlCellTypeConstants).ClearContents On Error GoTo 0 With Range("A3:M" & Lrr) .Sort .Columns(4), xlAscending End With End If Set cel = Nothing End Sub تحياتي