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

الظاهر انكم موديل قديم وما ادري اما انا فمن جماعة Amiga 1000 ، يعني ايام 286 🙂 جعفر

ياهلا بالاستاذ جمال نعم رحلة طويلة قبل حتى اقراص 5.25 كانت الاقراص 8.25 ثم بعد فترة نزلت اقراص 5.25 ثم 3.5 ما اشرت اليه كانت بدايتي مع انظمة ميكروسوفت واجهزة البي سي الشخصية ولدي قبلها تجربة مع اجهزة Mainframe وكذلك نظام UNIX وهو الاساس للانظمة الحديثة من اصدارات Linux ومشتقاته صحيح كلامك وكان اكبر هدية للمستخدم العربي قبل الويندوز برنامج اسمه النافذة كان يسمح باستخدام اللغة العربية في قواعد داتابيس 1 و 2 و كذلك في برنامج لوتس 123 وهو برنامج جداول ممتدة شعبيتة على الدوس مثل شعبية اكسل و برنامج libre calc من LibreOffice في الوقت الحالي الان التقنية تطورت بشكل كبير ومثل ما اختفت الاقراص المرنة سوف تختفي اقراص hd خصوصا ان اسعار ssd و m.2 اصبحت في متناول العديد من المستخدمين اول هارد ركبتة كان حجمة 20 ميجابايت وكان ثورة مقابل اقراص 3.5 بحجم 720 كيلوبايت وبحد اقصى 1.44 ميجا بايت للاقراص عالية الكثافة و2.88 ميجا قبل انتهاء زمنها 2.88 يتعطل اكثر مما يعمل

الاخوة الاساتذة الافاضل كل عام وحضراتكم بكل خير احببت مشاركتكم هذه المجموعة الجميلة من الازرار التى تستخدم بالفورم وهى تجميع من مشاركات الاساتذة بالمنتدى احترامى اخيكم New_Microsoft_Excel_Worksheet.xlsx المجموعة2 ازرار.xls

تفضل انتبه اخي قلت من a1 وو في الجدول الفعلي في ورقتك a9 لذلك هذا الكود يقوم بالاززاحة الى الاعلى ابتداءا من الخلية a1 و لا يحذف الصف كاملا اذا اردتت البدء من a9 غير في الكود Private Sub CommandButton2_Click() On Error Resume Next With Range("a1:d32") .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp End With End Sub تواتي 15.xlsm

تفضل Private Sub CommandButton2_Click() On Error Resume Next With Range("b9:b10000") .SpecialCells(xlCellTypeBlanks).EntireRow.Delete End With End Sub تواتي 15.xlsm

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

لا داعي لاي شيء فقط قم باخفاء الأعمدة التي لا تريدها مستعملاً هذا الماكرو Sub Hide_columns() Dim k% Sheets("Infos").Columns.Hidden = False Dim arr() arr = Array(3, 4, 5, 6, 7, 8, 9, 10) For k = LBound(arr) To UBound(arr) Sheets("Infos").Columns(arr(k)).Hidden = True Next End Sub في الصورة المرفقة حدد أرقام الأعمدة التي تريد اخفا ئها من خلال Array (تسلسل الأرقام داخل Array غير ضروري) Information_Advanced_Ar_date_1.xlsm

وعليكم السلام-يمكنك فقط استخدام هذه المعادلة =IFERROR(VLOOKUP(G3,$A$3:$C$200,3),"") قائمة تسديد 1TEST.xlsx

مشاركة مع الاخوة الاحبة ..... عسى أن يكون الكود قصيرا .... تفضل Aziz (2).rar

طبعا تضيف criteria معايير وشروط التنفيذ : =DCount("num_m7_tsd";"cargoo";" [startdate] = forms!copy_ff!startdate AND [time] > [Forms]![copy_ff]![time1] AND [time] < [Forms]![copy_ff]![time2]") dcount_where_date_time.accdb

برنامج الموارد البشرية HR "مفتوح المصدر" يحتوى على التالي : -بيانات الموظف . -الإجازات . - الأذنونات . - تسجيل الحضور يدوياً . - الخصومات . - السلف . - المكافأت . - تقيييم الموظف . - ساعات إضافية . - تقارير. - متابعة الحضور والانصراف . - تسجل الحضور والانصراف بشكل آلي . - تسجل الحضور بشكل يدوي . وخيارات أخرى . وهذا البرامج من تطويري وجدت جداوله في موقع خارجي . لا تنسونا من خالص الدعاء ،،، HR.rar

غير في هذا السطر For i = 1 To Sheets.Count حييث 1 يمثل الورقة 1 مثلا For i = 2 To 5 اي من الورقة 2 الى الورقة 5 غير حسب ما تريد

شكرااااا لك ☘️

كلنا ذلك الرجل لذا لدي في جهازي 10 اقراص صلبة مستقلة ليست مقسمة ولكون اللوحة الام تدعم فقط 7 اقراص واحد m.2 بمنفذ خاص للويندوز 10 وسته اقراص من نوع ساتا 3 والبقية باستخدام محول pci to sata يسمح بتركيب 8 اقراص اضافية لا اخي جمال انت حديث جدا لكونك استخدمت 486 تكون بدايتك من عام 1989 تاريخ انطلاق هذه السلسلة والتي انتهت عام 1993 باطلاق الجيل الاول من معالجات بنتيوم الشرف لنا استاذ جمال وعيدكم مبارك

جرب هذا الكود Private Sub CommandButton2_Click() On Error Resume Next Range("a9").Resize(9).SpecialCells(4) _ .EntireRow.Delete Shift:=xlUp End Sub

هل تقصد هذا الموضوع اخى محمد @حلبي

احسنت بارك الله فيك استاذ ابو الحسن

أخي التواتي . كان يجب التوضيح من الاول بأن هناك معادلات مع طلبك .ليتم اجابتك بسرعة .لعدم ضياع الوقت تفضل حبيبي الملف النهائي الازاحة الى الاعلى و ازاحة الخلايا التي تحنوي على المعادلات معها تواتي 15) fini.xlsm

اخى قد يفيدك هذا الموضوع احترامى

ممكن توضيح اكثر هل تقصد حذف واذا كان لا من اي صف يبدا ؟!

يالتوفيق أخي عدنان ولا تنس الضغط على أفضل إجابة .

ياااااااه سيادتك محظوظ أنك كنت في البدايات دي وتاريخ لا ينسي أهم شيئ عندي في وسائط التخزين مش مساحة تخزينهم وإنما عددهم ههههه وكل ما تزيد النسخ الاحتياطية عندي على اقراص التخزين تقل الكوابيس الليلية لأن عندي عقدة من فقدان الداتا هههههه سيادتك أقدم برضو ، أنا حضرت 486 والله سعيد وتشرفت بمعرفتكم استاذ kha9009lid واستاذ jjafferr

تفضل الملف بدون ضغط يا أخ حلبي Aziz.accdb

تنبيه عند إرفاق ملف إكسيل يجب أن يكون من نوع تمكين وحدات الماكرو حتى يتسنى للأعضاء المساعدة بإرفاق ملف العمل بعد التعديل فقط الكود يحتاج تعديل اسم ورقة العمل فقط Sub Transfer() Sheets("ترحيل واستدعاء").Activate For Each F In Range("e2:E1000") If F <> "" Then x = F.Value Range(F.Offset(0, -4), F.Offset(0, 0)).Copy LR = Sheets(x).Range("A" & Rows.Count).End(xlUp).Row Sheets(x).Activate Range("A" & LR + 1).Select Selection.PasteSpecial xlPasteValues End If Next F Sheets("ترحيل واستدعاء").Activate Application.CutCopyMode = False Range("A2:E1000").ClearContents MsgBox "تم الترحيل الى كل صفحة بنجاح" End Sub

هههههه انا من ايام 8086 ثم 8088 ثم بعد سنوات نزلت اجهزة 80286

اخى @ازهر عبد العزيز هل هذا ما تريد ع مثال اخى واستاذى @ابو تراب جزاه الله خيرا عندك النموذج الاساسى وعدلت تاريخين ليوم 20/5 جرب عليه وعندك النموذج الاخر frmcompare لاظهار جميع السجلات ثم التصفيه بناء على التاريخ بالتوفيق اخى New Microsoft Access Database (5) - Copy(2).accdb

السلام عليكم تم التعديل على قيم العمود A (بالمعادلات) من الورقة 111 (ورقة البيانات) والتعديل على كود "طباعة الكل" بما يفي الغرض المطلوب... برنامج شهادات نصف التيرم صف ثانى.xls

فعلا عملاق .. هههههههههههههههه

اهلا بك اخى ومرحب بعودتك للمشاركه معنا وخفف عن نفسك وانسى الماضى واستغفر لنفسك ولهم ولا تنسانا بارك الله فيك وكلنا اخوه فالله قبل كل شىء تجمعنا هنا من اجل هدف واحد وهو ان نتعلم ونستفيد ونفيد اخواننا فى الله بما من الله علينا من فضله وعلمه بارك الله فيك ومرحبا بعودتك مره اخرى اخى 💐 وتقبل الله منكم صالح الاعمال ونعود للمشاركه مع اخى @فايز.. و سؤال الاخ @adnan gharbi انظر المرفق ووافنا بالنتيجه بالتوفيق الاستعلام المطلوب.accdb

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

جميل جدا واستعلام واحد شيئ ملفت للنظر ربما لأني تركت الأكسس منذ فترة وأستأذنكم في طرح حل آخر ولا يهم إن كان المطلوب أم لا لأن غرضي من الطرح هو التعلم من سؤال عن إمكانية اختصار أربعة استعلامات صممتها للوصول للشكل بملف الوورد الذي أرفقه السائل - طبعا كثير وأربعة استعلامات أخرى لمطلوب لم يطلبه السائل هههههههه وقد استعنت بدالة من هذا المنتدى لعمل المطلوب الغير مطلوب Vibrators3.accdb

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

وعليكم السلام -اجعل المعادلة هكذا =IFERROR(E12-E13,"") معادلة1.xlsx

السلام عليكم ورحمة الله وبركاته الاستاذ الموقر/ سليم بارك الله فيك الملف الأخير تمام وكنت اطمع ان يكون العمل على صفحة العمل ( شيت تبيض الدور الأول ) فقط دون إضافة أى صفحات أخرى - Salim ، Sheet1 - واخر مجموعة لم يلصق تحتها دباجة وجزاكم الله خيرا ومازال الموضوع مفتوح مع صاحب الفضل جزاه الله الخير فى هذه الايام المباركة

بارك الله فيك وزادك من العلم

هذه مشكلة تقريب ، وبالمناسبة فهي مشكلة غريبة جدا للدالة Round المفترض أن : Round(82.5, 0) تساوي 83 لكن الدالة تعطي 82 في مشكلة غير مفهومة للأرقام الزوجية التي يصاحبها رقم خمسة بعد العلامة العشرية على العموم تم الحل باضافة 0.1+ Dynamic Array and form controls up 2.accdb

اللهم نور قلبه بنور الايمان وتقبل منه صالح الاعمال وزد في حسناته ياذا الطول والكمال.

=DCount("empol";"zahrah";" [startdate] Between [forms]![copy_ff]![startdate] AND [forms]![copy_ff]![enddate] And [zy] = true") وهذا نفس كود الفترة لكن بزيادة شرط جديد : And [zy] = true

شكراً وبارك الله بمجهودك

وبارك فيكم جرب الكود : =DCount("num_m7_tsd";"cargoo";" [startdate] Between [forms]![copy_ff]![startdate] AND [forms]![copy_ff]![enddate]")

ممتاز اخي الرائد حتى ولو كان عندي ملاحظة بسيطة من شأنها التسريع (للبيانات الكثيرة) 1 - الدالّة IFERROR في المعادلات الأفضل عدم استعمالها الا للضروروة لأنها تلزم الاكسل على حساب المعادلة واذا وجد خطأ يدرج فراغاً (مما يضيع الوقت سدى / جزء من الف من الثانية بالنسبة للحاسوب شيء كبير جداً / ) هذا بالإضافة الى ارهاق البرنامج بأشياء لا لزوم لها 2- الأفضل استعمال CountA لانه عندما رقم الصف يتجاوز الرقم المطلوب من خلال CountA يقوم اكسل بإدراج الفراغ ولا يفكر حتى بحساب نتيجة المعادلة 3- المعادلة المفترحة من عندي =IF(ROWS(B$4:B4)>COUNTA(A$4:A$1000),"",INDEX(A$4:A$1000,SMALL(IF(A$4:A$1000<>"",ROW(A$4:A$1000)-ROW(A$4)+1),ROWS(B$4:B4))))

وعليكم السلام-جرب الملف هكذا Amr2.xlsx

أولا أشكرك استاذي الغالي @jjafferr بارك الله فيك على سرعة الاستجابة ...... رحم الله والديك

نطاق الفاتر مؤلف من 10 اعمدة من A الى J لذلك لا يوجد عامود رقم 22

باختصار ان اسم المشروع مشابه لأسم الامر فلذلك يظهر الخطأ انظر الشرح المطول في هذا الموضوع ......

اتفضل اتمنى يكون كما طلبت Dim dbOther As DAO.Database Dim rs1 As DAO.Recordset Dim dbCurrent As DAO.Database Dim rs2 As DAO.Recordset Dim intI As Integer On Error GoTo ErrorHandler If IsNull(Me.txtImportFile) Then MsgBox "عذرا اخي الكريم ... لم تقم بإختيار قاعدة البيانات الخارجية", vbInformation DoCmd.CancelEvent Me.txtImportFile.SetFocus Else Set dbOther = OpenDatabase(txtImportFile) Set rs1 = dbOther.OpenRecordset("Table", dbOpenDynaset) Set dbCurrent = CurrentDb Set rs2 = dbCurrent.OpenRecordset("Table", dbOpenDynaset) If rs1.EOF Then Exit Sub intI = 1 rs1.MoveFirst Do While Not rs1.EOF With rs2 .AddNew !Name = rs1![Name] !Id = rs1![Id] !tel = rs1![tel] !country = rs1![country] .Update rs1.MoveNext intI = intI + 1 End With Loop MsgBox "تم تحديث بيانات جداول القاعدة الخارجية بنجاح", vbInformation End If rs1.Close Set dbOther = Nothing rs2.Close Set dbCurrent = Nothing Exit Sub ErrorHandler: MsgBox "Error #: " & Err.Number & vbCrLf & vbCrLf & Err.Description

وعليكم السلام اولا ، ارفق لك تغيير جدا طفيف ، وهو لتوقيف الخطأ اذا لم يكن هناك سجلات ، ثانيا ، المعادلة التي تفضلت بها غير عن المعادلة التي ارفقتها انا ، فما ادري اذا انت عملت تغيير آخر كذلك ّّ والافضل انك ترفق برنامجك الذي اعطاك الخطأ. Option Compare Database Public B As Long Public x() Public B2() Function Bal(ID, C, D) On Error GoTo err_Bal 'C = Cash 'D = Depo 'Do this for entry to the Function If B = 0 Then 'asign a Zero value to x(), 'we will need this so that the Function will NOT repeat 'going over the old records over and over due to scrolling the Query up and down Dim rst As DAo.Recordset Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_Cust_Deno_Depo WHERE [Receipt Date]=" & DateFormat([Forms]![Search]![MyDate])) rst.MoveLast: rst.MoveFirst RC = rst.RecordCount ReDim x(RC) ReDim B2(RC) For i = 1 To RC x(rst![Receipt Number]) = 0 rst.MoveNext Next i rst.Close: Set rst = Nothing End If If x(ID) = 0 Then '1st entry asigns values C = Replace(C, "-", 0) D = Replace(D, "-", 0) B = C + B - D Bal = B x(ID) = 1 B2(ID) = B Else 'for further visits, just take the already asigned value Bal = B2(ID) End If Exit_Bal: Exit Function err_Bal: If Err.Number = 3021 Then Resume Exit_Bal Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Function DateFormat(varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And DateFormat(The_Date_Field)") ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function جعفر 597.1.Test2.accdb.zip

شكرا على تنبيهي على هذا الخطأ هناك تغييرين في البرنامج ، 1. في الاستعلام ، فارسلنا رقم الوصل ايضا الى الوحدة النمطية ، 2. وهذه الوحدة النمطية الجديدة: Option Compare Database Public B As Long Public x() Public B2() Function Bal(ID, C, D) 'C = Cash 'D = Depo 'Do this for entry to the Function If B = 0 Then 'asign a Zero value to x(), 'we will need this so that the Function will NOT repeat 'going over the old records over and over due to scrolling the Query up and down Dim rst As DAo.Recordset Set rst = CurrentDb.OpenRecordset("SELECT * FROM Qry_Cust_Deno_Depo WHERE [Receipt Date]=#" & [Forms]![Search]![MyDate] & "#") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount ReDim x(RC) ReDim B2(RC) For i = 1 To RC x(rst![Receipt Number]) = 0 rst.MoveNext Next i rst.Close: Set rst = Nothing End If If x(ID) = 0 Then '1st entry asigns values C = Replace(C, "-", 0) D = Replace(D, "-", 0) B = C + B - D Bal = B x(ID) = 1 B2(ID) = B Else 'for further visits, just take the already asigned value Bal = B2(ID) End If End Function جعفر 597.1.Test2.accdb.zip

السلام عليكم هذا الكود ما نفعش معاك Sub Mail_workbook_1() 'Working in 97-2007 Dim wb As Workbook Set wb = ActiveWorkbook If Val(Application.Version) >= 12 Then If wb.FileFormat = 51 And wb.HasVBProject = True Then MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _ "Save the file first as xlsm and then try the macro again.", vbInformation Exit Sub End If End If On Error Resume Next wb.SendMail "", _ "This is the Subject line" On Error GoTo 0 End Sub وهو منقول من ملف عندي خاص بارسال ايميل فيه نفس الكود الذي تريد تعديله المرفق 2003 SendMail(Attachment)Testers.rar

أعزائي تم وضع ملف إرسال ملف الاكسل بالايميل عن طريق الاكسل بالمرفقات برجاء الاطلاع و الاستفادة شكرا SendMail_Attachment_Testers.rar