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

وعليكم السلام تفضل : Private Sub cmd_Export_to_Excel_Click() Dim xlApp As Object 'Excel.Application Dim xlWB As Object 'Excel.Workbook Dim rst As DAO.Recordset 'open excel template Set xlApp = CreateObject("Excel.Application") xlApp.Visible = False 'True Set xlWB = xlApp.Workbooks.Open(CurrentProject.Path & "\Excel Destn Temp.xltx") Set xlWS = xlWB.Worksheets(1) 'Expense report Number xlWS.Cells(4, 3).Value = Me.[Expense report Number] xlWS.Cells(4, 3).Font.Bold = True xlWS.Cells(4, 3).Interior.Color = vbRed 'Employee Code xlWS.Cells(6, 3).Value = Me.[Employee Code] xlWS.Cells(6, 3).Font.Bold = True xlWS.Cells(6, 3).Interior.Color = vbRed 'Employee Name xlWS.Cells(7, 3).Value = Me.[Employee Name] xlWS.Cells(7, 3).Font.Bold = True xlWS.Cells(7, 3).Interior.Color = vbRed 'the subform values Set rst = Me.Vouchers_Subform.Form.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount iRow = 10 'i + 1 For i = 1 To RC 'Sequence xlWS.Cells(iRow + i, 1).Value = i xlWS.Cells(iRow + i, 1).Font.Bold = True xlWS.Cells(iRow + i, 1).Interior.Color = vbRed 'VDate xlWS.Cells(iRow + i, 2).Value = rst!VDate xlWS.Cells(iRow + i, 2).Font.Bold = True xlWS.Cells(iRow + i, 2).Interior.Color = vbRed 'Expense Type xlWS.Cells(iRow + i, 3).Value = "jj" xlWS.Cells(iRow + i, 3).Font.Bold = True xlWS.Cells(iRow + i, 3).Interior.Color = vbRed 'Voucher NUMBER xlWS.Cells(iRow + i, 4).Value = rst!VoucherNUMBER xlWS.Cells(iRow + i, 4).Font.Bold = True xlWS.Cells(iRow + i, 4).Interior.Color = vbRed 'VA mount xlWS.Cells(iRow + i, 6).Value = rst!VAmount xlWS.Cells(iRow + i, 6).Font.Bold = True xlWS.Cells(iRow + i, 6).Interior.Color = vbRed rst.MoveNext Next i xlApp.Save 'ask the user to save the new file xlApp.Quit Set xlWS = Nothing Set xlWB = Nothing Set xlApp = Nothing End Sub جعفر 677.Export to excel temp.zip

وعليكم السلام سيدي العزيز أبو نادر من تجربتي لبرامج الاجازات ، ولعدم حصول تكرار ، والأهم ، هو لسرعة البرنامج: الجدول: اسم او رقم الموظف ، ترقيم الاجازة (سنوي) ، تاريخ الاجازة ، نوع الاجازة ، ملاحظات ، تم قطع الاجازة (نعم/لا) ، والقيمة الافتراضية يجب ان تكون صفر (يعني لا) . النموذج: ادخال التاريخ ، من و الى ، عند الموافقة ، يكون هناك زر لتفكيك الاجازة الى ايام ، وحفظها في الجدول ، زر امكانية تغيير قطع اجازة الموظف ، كذلك بين التاريخين ، وتحديث الجدول ، والملاحظات ، إن وُجدت. الاستعلام: اسم او رقم الموظف ، وقد يكون بمعيار ، تاريخ الاجازة ، والمعيار يكون بين تاريخين ، تم قطع الاجازة ، والمعيار يكون صفر. واذا اردت اضافة قسم الموظف ، فاعمل استعلام آخر ، واربط اسم او رقم الموظف بجدول الاقسام ، اما الحقول المحسوبة مثل: اليوم ، فهذه تعملها في الاستعلام مباشرة ، ولا تُحفظ في الجدول. الآن الموضوع سيكون في غاية السهولة ، والسرعة في احد برامجي ، كان هناك اكثر من ثلاثين الف اجازة في الشهر ، وكُله مشى تمام وهناك مَثل شهير في قواعد البيانات: الحقول غالية ، والسجلات رخيصة جعفر

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

برنامج_مخازن_جديد.xlsm

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

السلام عليكم ورحمة الله تم عمل المطلوب... بن علية حاجي الصف الاول ب - قائمة فصول.rar

وعليكم السلام في احد برامجي اضطررت ان اقوم بشيء شبيه لما تريد عمله ، ولكن ليس بتمرير الفأرة ، وانما بالنقر على زر في السجلات ، والكود المرفق هو لذلك الزر ، الزر في النموذج الفرعي frm_Beads ، واسم النموذج الرئيسي frm_M_Beads ، ونموذج الصورة اسمه frm_Show_Image ، Private Sub cmd_frm_Show_Image_Click() DoCmd.OpenForm "frm_Show_Image" 'get the BE path BE_Path = application.currentproject.path Image_Name = Format(Forms!frm_M_Beads!frm_Beads!Auto_Date, "yyyy_mm_dd-hh_nn_ss") Forms!frm_Show_Image!Scan.Picture = BE_Path & "\Images\Items\" & Image_Name & ".jpg" Exit Sub err_cmd_frm_Show_Image_Click: If Err.Number = 2465 Or Err.Number = 2450 Then 'Form Not open Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر

السلام عليكم ورحمة الله وبركاته اخي محمد انا نزلت المرفقك الرئيسي اللي مع السؤال 1 / ما فيها هذا الخطأ 2 / يظهر هذه الرسالة فقط عند وجود اسم اخر بنفس الاسم وما يظهر لكل من هو جديد نزل مرفقك من جديد وجربه واحكينا ما تراه ونحن ما نرى

شرح الكود explain_code.rar

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

السلام عليكم ورحمة الله أخي الكريم فايز، لست أدري إن كان ما في الملف المرفق هو ما تريد؟ بن علية حاجي الصف الاول ب - قائمة فصول.rar

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

في الحقيقة وصدقني لست بعبقري إنما هو تدريب واجتهاد وبحث في المنتديات و و و .. مجرد اجتهاد بالنسبة للنقطة التي سألت عنها قمت باستخدام دالة Countif وهي دالة العد بشرط .. رأيت أنك تقوم بالعد في المعادلة ولكن النتيجة لم تكن كالمتوقع بالنسبة إليك .. فخطر ببالي أن المشكلة أنك تقوم بالعد بدالة Count فالنتيجة ستكون واحدة لأن الخلايا ليست فراغ إنما الفراغ نتيجة معادلة والفراغ هنا يساوي صفر .. فاستخدمت دالة Countif وأخبرته أن يقوم بالعد للخلايا التي لا تحتوي على الفراغ أو الصفر .. وكلمة لا يساوي تكتب بهذا الشكل <> يعني علامة أقل من ويليها علامة أكبر من ، وتوضع العلامة بين أقواس تنصيص ثم تستخدم أداة الرابط & ثم توضع القيمة أو الشرط 0 بالنسبة للنقطة الثانية أخبرتك أنني أفضل الموضوع أن يكون ذو طلب واحد .. راجع التوجيهات في الموضوع المثبت في صدر المنتدى للمزيد حول الأمر تقبل تحياتي

اشكرك جزيلا استاذنا ومعلمنا الفاضل ياسر فدائما تكون لنا عونا ولك جزيل الشكر ملحوظة بسيطة دائما وابدا انا متأكد مما تقوله (للايضاح فقط ) .

التنسيق يخفي الأصفار ..جربه مرة أخرى بعد الإطلاع على ملفك جرب المعادلة التالية في الخلية M6 =IFERROR((SUM(D6:F6)-COUNTIF(G6:K6,"<>"&0))*L6+SUM(G6:K6),"")

وعليكم السلام وبدون انزال برنامجك ، فالفكرة ليست صحيحة في عالم قاعدة البيانات فكرة قاعدة البيانات هي ، ادخال بيانات ، فرز وتصفية ، اخراج تقارير فالطريقة الصحيحة هي ان يكون جدول واحد لجميع السنوات ، والفرز والتصفية يكون بحقل فيه تاريخ السنه التي تريدها (مثل تاريخ الصادر او الوارد) ، او اذا كلا ولابد ، فاضافة حقل للسنه جعفر

أخي الكريم محمود بص بقا دا ملوش علاقة بالإكسيل وأنا متأكد من الكلام اللي بقوله .. لو مش مصدقني جرب بنفسك فيه مفتاح في لوحة المفاتيح اسمه Insert دا أحياناً وإنت بتكتب ممكن تضغط عليه عن طريق الخطأ (ودا وارد .. مش صادر) فتعمل ايه عشان تخلص من المشكلة دي .. بسيطة جداً جدي : تضغط نفس المفتاح تاني (جرب وشوف .. من غير خوف)

يمكن استعمال هذا الماكرو (الملف مرفق)صفحة salim Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Arr Dim x%, n% Application.EnableEvents = False On Error Resume Next If Target.Column = 2 And Target.Row > 2 And Target.Cells.Count = 1 Then Arr = Array("X", "ص", "م", "ع", "ض") Application.AddCustomList ListArray:=Arr x = Application.Match(Target, Arr, 0) If x Then Target.Offset(0, 1) = Target Target.Offset(0, 1).AutoFill Target.Offset(0, 1).Resize(1, 23) Else MsgBox "Unvaliable Value": Target.Resize(, 24) = "" End If End If 1: n = Application.GetCustomListNum(Array("X", "ص", "م", "ع", "ض")) Application.DeleteCustomList n Application.EnableEvents = True End Sub عداد Salim WithVBA.rar

السلام عليكم تفضل هذا التعديل على الكود الذي تستعمله: Dim strTargetDB As String Dim tbl As TableDef Dim app As Access.Application strTargetDB = Me.txtPath1 Set app = CreateObject("Access.Application") app.OpenCurrentDatabase (Me.txtPath) app.Visible = False For Each tbl In CurrentDb.TableDefs If Left(tbl.Name, 4) <> "MSys" Then app.DoCmd.TransferDatabase acExport, "Microsoft Access", strTargetDB, acTable, tbl.Name, tbl.Name, False End If Next و هذا ملفك بعد التعديل عليه موفق إن شاء الله 1‏‏kanory.rar

الاخوة الزملاء احب ان اشكر كل الزملاء بالمنتدى على مجهودهم الذى استفدت منه وان شاء الله ساستعين فى الشرح القادم بمجهودهم مع بعض التعديلات وذلك لشرح الطرق المتعددة للفورم للاستفادة منها فورم بحث وتعديل واضافة بيانات الدرس الثامن نتعرف على ComboBox البحث برفم الجلوس Private Sub ComboBox1_Change() Set sh12 = Sheets("بيانات") Lr = sh12.[a2000].End(xlUp).Row For Each CL In sh12.Range("a5:b" & Lr) If (Val(Me.ComboBox1)) = CL Then Me.TextBox1 = CL.Offset(0, 0) Me.TextBox2 = CL.Offset(0, 1) Me.TextBox3 = CL.Offset(0, 2) Me.TextBox4 = CL.Offset(0, 3) Me.TextBox5 = CL.Offset(0, 4) Me.TextBox6 = CL.Offset(0, 5) Me.TextBox7 = CL.Offset(0, 6) Me.TextBox8 = CL.Offset(0, 7) Me.TextBox9 = CL.Offset(0, 8) Me.TextBox10 = CL.Offset(0, 9) Me.TextBox11 = CL.Offset(0, 10) End If Next End Sub البحث برقم الجلوس مع اظهار عمودين الرقم والاسماء Private Sub ComboBox2_Change() Set sh12 = Sheets("بيانات") Lr = sh12.[a2000].End(xlUp).Row For Each CL In sh12.Range("a5:c" & Lr) If (Val(Me.ComboBox2)) = CL Then Me.TextBox2 = CL.Offset(0, 1) Me.TextBox1 = CL.Offset(0, 0) Me.TextBox3 = CL.Offset(0, 2) Me.TextBox4 = CL.Offset(0, 3) Me.TextBox5 = CL.Offset(0, 4) Me.TextBox6 = CL.Offset(0, 5) Me.TextBox7 = CL.Offset(0, 6) Me.TextBox8 = CL.Offset(0, 7) Me.TextBox9 = CL.Offset(0, 8) Me.TextBox10 = CL.Offset(0, 9) Me.TextBox11 = CL.Offset(0, 10) End If Next End Sub

جزاك الله خيرا

مجهود رائع و شكرا جزيلا

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

دورة من ثلاث مستويات فى على الإدارة منقول عن المؤلف : المهندس / عبد الله العتيبى الدرس الأول الدرس الثانى الدرس الثالث