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

السلام عليكم و رحمة الله تعالى وبركاته نعاني دائما من تصدير البيانات إلى الوورد للتعديل عليها أو لأي غرض آخر و خاصة الجداول أقدم لكم هذا المثال البسيط الذي يقوم بتصدير البيانات لملف وورد معد مسبقا و يقوم بملئها في أماكنها و كلما زاد سجل زاد له سطر في جدول الوورد و هذا هو المثال فيه نسختين 2003 و نسخة 2010 التصدير لملف وورد معد مسبقا.rar

بعد اذن الأستاذ سليم -تفضل كود واحد يرحل جميع البيانات الى جميع الادارات وفق اسم الادارة ونوع المدرسة2.xlsm

يارك الله فيك اخي علي وهذا كود اخر يعتمد على Dictionary لتحديد المدارس المطلوبة و على Auto Filter لكل مدرسة اظن انه أسرع لنقل ال Data الى الصفحة المطلوبة Option Explicit Sub test() '====>>> CREATED BY SALIM ON 28/7/2019 Application.ScreenUpdating = False '+++++++++++++++++++++++++++++++++++++++ Start Of DIM Dim Fst As Worksheet: Set Fst = Sheets("Data") 'First Sheet Dim Sec As Worksheet ' Seconde sheet Dim LRU% ' LRU Num of Rows in First sheet column U Dim i%, ky, m%: m = 6 'm row's number when the data will start Dim D As Object ' D Dictionary Dim Fst_Rg As Range 'My range On first sheet '+++++++++++++++++++++++++++++++++++++++ End Of DIM Set D = CreateObject("Scripting.Dictionary") LRU = Fst.Cells(Rows.Count, "U").End(3).Row Set Fst_Rg = Fst.Range("a2").Resize(LRU, 30) '''''''''''''''''''''''''''Start Of For_next Loop to fill the Dictionary For i = 3 To Fst_Rg.Rows.Count If Not D.exists(Fst.Cells(i, "U").Value) And _ Len(Fst.Cells(i, "U")) > 3 Then D.Add Fst.Cells(i, "U").Value, "" End If Next i '''''''''''''''''''''''''''End Of For_next Loop to fill the Dictionary '+++++++++++++++++++++++++++++++++ fil All sheets with auto filter For Each ky In D.keys Set Sec = Sheets(ky) Sec.Range("c6").CurrentRegion.ClearContents ' Clean Up the Data in Seconde sheet Fst_Rg.AutoFilter 21, CStr(ky) 'filter by column(21)==>> N Fst_Rg.Cells(1, 1).Resize(LRU - 1, 20).SpecialCells(12).Copy _ Sec.Range("C" & m) Next ky '++++++++++++++++++++++++++++++++++++ If Fst.FilterMode Then _ Fst.ShowAllData: Fst_Rg.AutoFilter '====== Clear Autofilter from sheet Data '++++++++++++++++++++++++++++++++++++++ Clean Up the Memory D.RemoveAll: Set D = Nothing: Set Fst_Rg = Nothing Set Fst = Nothing: Set Sec = Nothing '++++++++++++++++++++++++++++++++++++++ Application.ScreenUpdating = True End Sub

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

أخى الكريم albrkani اذا كان المطلوب تم كما تريد على اكمل حال فلابد من التعبير عن هذا بالضغط على الإعجاب لصاحب هذا الفضل فى حل هذه المشكلة كما عليك بالضغط على علامة أفضل اجابة

ربما يفيدك هذا الملف ايضاً بعد اذن الاخ وجيه Test.xlsx

جرب هذا الملف بعد اذن اخي علي طبعاً Time_AM_PM.xlsm

بسبب تنسيق حقل تلفون في جدول رقم ممكن تغيره الى نص لان حقل رقمي لا يقبل علامات نصية

وعليكم السلام تم تنفيذ طلبك بمعادلة IF مع دالة معرفة LETTEROUT Function LETTEROUT(RNG As Range) Dim I As Integer For I = 1 To Len(RNG) Select Case Asc(Mid(RNG.Value, I, 1)) Case 0 To 64, 123 To 197 LETTEROUT = LETTEROUT & Mid(RNG.Value, I, 1) End Select Next I End Function وهذه هي المعادلة المطلوبة =IF(RIGHT(B2,2)="AM",LETTEROUT(B2),IF(RIGHT(B2,2)="PM",LETTEROUT(B2)+12,"")) A.xlsm

وعليكم السلام-تفضل حساب أسابيع العمل.xlsm

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

كن في الحياة كشآرب القهوة !.. يستمتع بهــا رغم سوآدها ومرآرتهآ وتذكر قول الخشب للمسمار: لقد كسرتني وألمتني فرد المسمار قائلاً : لو كنت رأيت الدق فوق رآسي لكنت عذرتني فليعذر النآس بعضهم البعض فكل شخص لآيعرف ظروف الآخر إذآ إستمريت بـ هذه الحسآسية الزآئدة . . والحزن علي كل تصرف , فـ إنك ستحوّل حيآتك إلي جحيم ! تذكَر .. أن النآس تختلف في تفكيرهآ وطبآعهآ فما ترآه أنت جآرحاً .... قد يرآه غيرك أمراً تآفهاً هنآك موآقف مؤلمة قد تتعرض لهآ ولكن , إلي متي تجتر الموقف وتقف عليه ! إن أصآبك الألم ! عشه في لحظته .. ثم تجآوزه وكآفح من أجل تجاهله أشغل نفسك .. تنآسآه حتي يغيب عن ذآكرتك ! إحفظ لسانك أيها الإنسان لا يلدغـنـّك .. إنه ثعبان فكم في المقابرمن قتيل لسانه كانت تهاب لقاءه الشجعان وإذا حار أمرك في معنيين ولم تدرِ أين الخطا والصواب فخالف هواك فإن الهوى يقود النفوس إلى ما يعاب ولا تحاسب النآس عندما يخطئوآ ولا تذهب لغيرهم لتشكوا منهم .. لسانك لا تذكر به عورة امرئ فكلك عـورات وللــناس ألـســــــن وعينك إن أبدت إليك من الناس مساوءً فقل يا عيني للنـاس كذلك أعين واقضى حاجة المحتاج حتى لو كان اليك مسيئاً فأفضل الناس مابين الورى رجل تقضى على يده للناس حاجات لا تمنعن يد المعروف عن أحد ما دمت مقتدرا فالسعد تارات واشكر فضائل صنع الله إذ جعلت إليك لا لك عند الناس حاجات مهما إختفت من حياتك أمور ظننت أنها سبب سعادتك ! تأكد أن اللـه صرفها عنك قبل ان تكون سبباً في تعاستك عليك بتقوي الله ان كنت غافلاً أنظر لحالك كيف تعصاه ويأتيك بالارزاق من حيث لا تدري فكيف تخاف الفقر والله رازقاً فقد رزق الطير و الحوت في البحر و من ظن ان الرزق يأتي بقوة ما اكل العصفور شيئاً مع النسر تزول عن الدنيا فانك لا تدري اذا جنّ عليك الليل هل تعيش الي الفجر فكم من صحيح مات من غير علة و كم من سقيم عاش حيناً من الدهر وكم من فتي امسي و اصبح ضاحكاً وأكفانه في الغيب تنسج وهو لا يدري فمن عاش الفاً و الفيـــــــــــــن فلا بد من يوم يسير الـــــي القبـــــــــــر صافح وسامح .. ودع الخلق للخالق .. {فأنت****** .. وهم****** ..ونحن****** .. كلنا راحلوون إفعل الخير مهما استصغرته .. فلآ تدري أي حسنة تدخلك الجنة

ما شاء الله تبارك الله ..... برنامج جميل ..... تشكر عليه

قم باختيار الحقلين بالضغط على Shift ثم الضغط على المفتاح .... انظر ....

وعليكم السلام ورحمة الله نعم يمكن ذلك ....... ما شاء الله وصلت لمرحلة تصميم الجداول .... عمل ممتاز ..... واصل .....

وعليكم السلام-أهلا بك في منتدانا الكريم ,تفضل لك ما طلبت رسالة تنبيه.xlsx

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

انظر لهذا الملف لعله يفى بالغرض حساب مقدار التاخير.xlsx

ليتك تعمل زحمة وتشرح بالتفصيل ما تريد وتضع مرفق ::بالتوفيق::

ان شاء الله جاري عمل عليه

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

اشكرك اخي الحبيب علي الشرح الوافي واسف جدا علي تعب وازعاج حضرتك بارك الله فيك يااخي

إذا وجهتك مشكلة فى أداء أي من تطبيقات أوفيس 2019 على ويندوز 10 قم بتفعيل خيار Disable Hardware Graphic Accelerator من File>options >advanced>Display من خيارات اي من تطبيقات الاوفيس ، و ستنطبق عليها جميعا و جرب الاداء 😀 وبالطبع هذا لا ينطبق على جميع الأجهزة ، و لكن يناسب العديد من اجهزة اللاب توب ، و لكن من ناحية أخرى هناك أجهزة تحتاج هذه الخاصية و لا يجب ايقاف تفعيلها فيها بحسب مواصفات الجهاز ، و التجربة هي خير دليل ، اذا واجهتك مشكلة جرب إلغاء الخاصية ، و اذا لم تأت بالنتيجة المطلوبة ، أعد تفعيلها و يادار ما دخلك شر 😎

هو كل يوم بيعمل نسخة جديدة بتاريخ اليوم-وبالتأكيد لا يمكن تغيير هذا التاريخ الذى تم عمل النسخة به فمثلا اذا تم عمل نسخة النهاردة سوف يتم عمل النسخة بتاريخ 29/07/2019 ولا يمكن تغيير هذا التاريخ في اليوم التالى ففي اليوم التالى او غدا سوف يتم عمل نسخة جديدة عند فتح الملف بتاريخ 30/07/2019 .....وهكذا

السلام عليكم اخي محمد صلاح الصق هذا كود في حدث بعد تحديث للمربع نص مراد كتابة رقم تليفون فيه If IsNull(ActiveControl) Or ActiveControl = "" Then Exit Sub Dim vl As String vl = ActiveControl.Value vl = Replace(vl, "(", "") vl = Replace(vl, ")", "") vl = Replace(vl, "-", "") vl = Replace(vl, " ", "") If Mid(vl, 4, 1) = 0 Then vl = Format(vl, "(000) 0000-0000-000") Else vl = Format(vl, "(000) 000-00-000") End If ActiveControl = vl Database1712.accdb

وعليكم السلام-تفضل 111.xlsm

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

جرب هذا -كما يمكنك حذف الملف نزولا لرغبتك اذا أردت هذا وهناك رابط اخر في المنتدى يمكنك رؤيته https://www.officena.net/ib/topic/45680-هذا-كود-لإظهار-نافذة-تفعيل-الماكرو-مع-تشغيل-الملف/ مراجعة القرأن الكريم.xlsm

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

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

ولك بمثل ما دعوت لى وزيادة والحمد لله الذى بنعمته تتم الصالحات

تم اضافة الحماية على الملف فى المشاركة السابقة لعدم العبث بالخلايا والمعادلات بارك الله فيك

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

وعليكم السلام-تفضل https://www.officena.net/ib/topic/46756-ترحيل-بيانات-من-ملف-اكسل-الى-اكسس/ https://www.youtube.com/watch?v=RelLvfilOnQ

وعليكم السلام -تفضل لك ما طلبت كما تم عمل شاشة دخول بكلمة سر يمكنك فقط اختيار الإسم من الكمبوبوكس وهو : Abdelkarem وكلمة السر : 1111 شحن.xls

لو ممكن رفع ملفك لنرى ما هي المشكلة ؟

ابشرك أخي الكريم kanory وجدت على اليوتيوب بعض الدروس ....

حياك الله ....

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

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

جرب هذا الملف الصراحة الكود مقتبس ولا أعرف واضعه Moukhalafat.xlsm

أخى الفاضل qathi نظرا لأن نوع الحقل RepairType نصى فيجب وضع الارقام الخاصة به بين علامتى تنصيص Expr1: IIf([RepairType]="1";"صيانة";IIf([RepairType]="2";"برمجة";IIf([RepairType]="3";"صيانة وبرمجة";""))) بالتوفيق عفوا أخى kha9009lid لم أدرك انك قمت بالاجابه

جرب المرفق Re.accdb

حسب ما فهمت من السؤال ربما يكون هذا الملف نموذج عما تريد اذا ادركت انك ادرجت اسماً بالخطأ اضغط على الزر Undo كلما ضغطت مرة على Undo تستطيع أن تمسح اخر تسجيل في الصفحة الثانية اذا اردت مسح كل البيانات من الصفحة الثانية اضغط على الزر Clear Data Direct to Other_Sheet.xlsm

شوف اذا هذا صحيح 🙂 للأسف ، الكلمات العربية قلبت الكود ، فما ممكن نقرأه بالطريقة الصحيحة !! . . جعفر 1105.Database2 - Copy.accdb.zip

تفضل =IF(YEAR(DATE($A$2,1,ROW(A1)))=$A$2,DATE($A$2,1,ROW(A1)),"") المصنف1.xls

. وأخي العزيز ، نموذجك ليس بالكامل unbound ، فعندك مربح التحرير ComboBox متصل بالجدول مباشرة الطريقة اللي انا عملتها في احد برامجي السابقة كانت كالتالي: 1. عملت وحدة نمطية كالتالي: Option Compare Database Option Explicit Dim cnn As New ADODB.Connection Dim srstADO As ADODB.Recordset Public Function ComboRecordset(strCombo As Control, strSQL As String) 'do the Recordset for the Form's ComboBoxes 'open a connection if the connection is not open ' If cnn.State <> adStateOpen Then Call ConnectSQL(cnn) ' End If Set srstADO = New ADODB.Recordset With srstADO .Source = strSQL .ActiveConnection = cnn .CursorType = adOpenKeyset .LockType = adLockOptimistic .CursorLocation = adUseClient .Open End With Set strCombo.Recordset = srstADO 'close the ADO object, once the data are set in the controls If srstADO.State = adStateOpen Then srstADO.Close Set srstADO = Nothing End If End Function Public Function ConnectSQL(cnn) 'Set a global SQL Server connection object 'Stop On Error GoTo error_handler 'open a connection if the connection is not open 'If cnn.State <> adStateOpen Then ' Call ConnectSQL(cnn) 'End If If cnn.State = adStateOpen Then Exit Function End If Dim sConnect As String Dim BE, BE_File BE = "Access" If BE = "Access" Then BE_File = "C:\temp\ABC_BE\ABC_BE2.mdb;" sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ "Data Source=" & BE_File End If 'BE If Not cnn Is Nothing Then Set cnn = CreateObject("ADODB.Connection") cnn.ConnectionString = sConnect cnn.Open End If If cnn.Errors.Count > 0 Then 'hide the error message, as the system still runs ok MsgBox "An error occured while attempting to connect to SQL Server BOND: " & vbCrLf & cnn.Errors(0).Number & vbCrLf & cnn.Errors(0).Description, vbOKOnly, "" End If exit_function: 'Nothing to do here Exit Function error_handler: ' Stop MsgBox Err.Number & vbCrLf & Err & ", " & Error$ 'MsgBox Err & ", " & Error$ Resume exit_function End Function . 2. وفي حدث On_Load النموذج ، كان هذا الكود ينادي الوحدة النمطية ، ويملئ ComboBox: 'set the ComboBoxes Recordsets 's__Folder_Number strSQL = "SELECT DISTINCT Folder_Number FROM tbl_Folders WHERE Folder_Number Is Not Null;" Call ComboRecordset(s__Folder_Number, strSQL) 'i__Folder_Year strSQL = "SELECT DISTINCT Folder_Year FROM tbl_Folders WHERE Folder_Year Is Not Null;" Call ComboRecordset(i__Folder_Year, strSQL) للعلم جعفر

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

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

_____________________1______200702.rarاخي يارب المرة دي نقدر نفيد جرب الملف المرفق