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

السلام عليكم ورحمة الله كود للبحث بالرقم القومى و تلوين الاسم Sub SearchData() Dim ws As Worksheet, Sh As Worksheet Dim lr As Long, i As Long Dim data Set Sh = Sheets("البحث") data = Sh.Range("C7").Value Application.ScreenUpdating = False For Each ws In Worksheets If ws.Name <> "البحث" Then lr = ws.Range("A" & Rows.Count).End(3).Row i = 8 Do While i <= lr If ws.Cells(i, 1) = data Then Sh.Range("C8").Value = ws.Cells(i, 2).Value Sh.Range("C9").Value = ws.Cells(i, 3).Value Sh.Range("C10").Value = ws.Cells(i, 4).Value Sh.Range("C11").Value = ws.Cells(i, 5).Value ws.Cells(i, 1).Interior.ColorIndex = 10 End If i = i + 1 Loop End If Next Application.ScreenUpdating = True End Sub

استخدم هذا الكود في الزر لديك .... واعلمنا بالنتيجة ...... Dim i, j As Integer Dim rs As DAO.Recordset Set rs = CurrentDb.OpenRecordset("mytable") For j = 1 To WebBrowser3.Document.getElementsByTagName("table").Item(0).rows.Length - 1 rs.AddNew rs!t1 = WebBrowser3.Document.getElementsByTagName("table").Item(0).rows(j).cells(1).innerText rs!t2 = WebBrowser3.Document.getElementsByTagName("table").Item(0).rows(j).cells(2).innerText rs.Update Next MsgBox "تم الاستيراد بنجاح"

طريقة جميلة اخي @kanory لكن في حالة خذف سجل سيكون هناك خطأ في عدد السجلات في الصفحة والافضل من رأيي ان يكون الكود يعتمد على حقل غير متضم للترقيم في التقرير انظر للصفحة الاولى بعد حذف 5 سجلات اصبحت الصفحة الاولى 15 سجل

واياك .... الحمد لله رب العالمين ....

الكود المطلوب Dim st Private Sub CommandButton1_Click() With Sheets("Salim").Range("A1") .Range("A1").ClearContents .Value = st End With End Sub '+++++++++++++++++++++++++++++++++ Private Sub UserForm_Initialize() st = "الأهداف:" & Chr(10) & _ Space(5) & "1 - تحديد مفهومي مفاتيح الأداء و مفاتيح التأطير و دواعي العمل بهما" & Chr(10) & _ Space(5) & "2 - تحليل بعض الكفاءات الختامية باعتماد مفاتيح التأطير و مفاتيح الأداء" & Chr(10) & _ Space(5) & "3 - دواعي وضع مناهج جديدة ( مناهج الجيل الثاني ) " TextBox1.Text = st End Sub الملف مرفق List_box51.xlsm

هذه طريقة اخرى قد يكون طبلك ..... تقرير.rar

أولاً- لا ادري ما الغاية من دمج الخلايا (من A الى J ) في خلية واجدة كما في الصورة الأولى ثانياُ يجب حذف المسافة الزائدة بين كلمة الأهداف والنقطتين (الاهداف ؟؟ 🙂 List_box50.xlsm

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

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

الحمد لله

جرب هذا النموذج (و حاول تطبيقه على الملف عندك) Days.xlsx

وعليكم السلام-يمكنك استخدام هذه المعادلة =IFERROR(NETWORKDAYS.INTL(L2,A2,6),"لم يصرف") تقرير فواتير مبيعات رواج من 1-1-2021 الى 18-1-2021.xls

السلام عليكم ورحمه الله وبركاته هدية لأعضاء المنتدى الكرام برنامج أرشفة الخطابات و الوثائق .. الأرشفة الالكترونية مفتوح للعمل عليه غير محدد المدة ومش تجريبي مغلق المصدر (الاكواد) وتعديل النماذج تحياتي user 1234 1118021174_Archivesopen18-1-2021.rar

السلام عليكم تم تعديل آلية الترقيات السابقة ، حيث تم اضافة شرط لعدد نقاط الاعجاب لتنفيذ الترقية الالية ، كما هو مبين أدناه الدرجة الحالية المشاركات نقاط االاعجاب عضو جديد 01 50 - 02 الأعضاء 100 10 03 عضو مميز 500 50 04 عضو فضي 1000 100 05 عضو ذهبي 1000 500 06عضو ماسي 1000 1000 عند وصول نقاط الاعجاب الي 1000 للعضو الماسي سيتم الترقية الي مجموعة أعضاء الشرف و التي تضم أيضا المكرمين من ممن لهم مساهمات خارج الموقع و ستتغير الدرجة بالترقية للأعلى بعد اول مشاركة للعضو ، و لن يتم تخفيض أي درجات حالية. و تبقي مجموعات الخبراء و فريق الموقع و فريق الموقع السابق و أعضاء الشرف دون تعديل كما سيتم قريباً بإذن الله استحداث درجة خبير مخضرم لتكون الترقية التالية لدرجة خبير و سيتم الاعلان قريبا عن موعد تطبيقها و آلية التطبيق

يمكنك الكتابة بصوتك على برنامج الوورد بطريقة سهلة جداً مشروحة في الفيديو التالي https://youtu.be/mE4Idf0pDUc

حمل قاعدة البيانات المرفقة او حمل البرنامج من الرابط التالي https://www.mediafire.com/file/5zluqkxukwi6rda/age.accdb/file age.accdb

تعديل بالنسبة للغة الأجنبيىة كل شيء تمام (لا مشاكل في الاسطر الفارغة) بالنسبة للغة العربيى هناك مشكلة بالصفوف الفارعة (ولا أعرف طريقة حلها) List_box52.xlsm

الكود لمن يحتاجه ويعمل تمام بس عند تغير عدد الصفوف الى 15000 بياخد وقت طويل السادة الاساتذة حل للحلقة التكرارية لجعل الكود اسرع بارك الله فيكم مع الشكر Option Explicit Sub GetDataDemo() Dim FilePath$, Row&, Column&, Address$ Dim mpth Dim mfL 'change constants & FilePath below to suit '*************************************** Const FileName$ = "**" Const SheetName$ = "ورقة1" Const NumRows& = 10 Const NumColumns& = 10 Dir (mpth & "*xls*") mpth = ThisWorkbook.Path & "\do\" mfL = Dir(mpth & "*xls*") '*************************************** DoEvents Application.ScreenUpdating = False If Dir(mpth & mfL) = Empty Then MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist" Exit Sub End If For Row = 1 To NumRows For Column = 1 To NumColumns Address = Cells(Row, Column).Address Cells(Row, Column) = GetData(mpth, mfL, SheetName, Address) Columns.AutoFit Next Column Next Row ActiveWindow.DisplayZeros = False End Sub Private Function GetData(Path, File, Sheet, Address) Dim Data$ Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _ Range(Address).Range("A1").Address(, , xlR1C1) GetData = ExecuteExcel4Macro(Data) End Function

و من أين لي ان اعرف ماذا تريد ان تكتب في التكست بوكس؟؟؟؟ على كل حال ضع النص الذي تريده داخل الكود

حياك احمد ..... ممكن ولكن لو زوتنا بمرفق كمثال للعمل عليه

نعم صحيح اخي .... ما ما حبيت اغير في البرنامج ..... المفروض ما نعتمد على التسلسل الموجود في الجدول .... نعمل مربع نص خاص و نجعله غي منضم ومصدرة =1 بارك الله فيك لا حظ المرفق الجديد للفائدة حتى تكتمل الفكرة تقرير.rar

بارك الله فيك وربي يجعلها حسنة في ميزان حسناتك اخي kanory تمام وهذا هو المطلوب اشكرك وتحياتي الك

نعم كما تفضلت اخي احمد سوف يتم اختصار بعض الجداول اما الحركات فهي في جدول واحد ولكن يبدوا ان اخونا لم تعجبه فكرة استبعاد عمودي دائن/مدين لا نعلم فقد يضطر للانسحاب كعملية تكتيكية للدفاع عنهما

السلام عليكم ورحمة الله وبركاته اثراء الموضوع .. عن طريق المعادلة .. يوجد معادلتين .. في الشيت .. TAKSIM_TO COL.xlsm

راجع الموضوع التالي أين تمت مناقشة طلبك رابط الموضوع

تفضل بعد اذن الأستاذ ابراهيم طبعاً ... فكان عليك تعيين زر لحسن عمل الكود , تفضل نسخة من المصنف1 1.xlsm

رائع فعلا البرنامج كان بيغيب جدااا بارك الله فيك وزادك علما يارب بارك الله فيك استاذ سليم

تبدأ من أول وجديد يجب ان تكون خطواتك علمية مدروسة خطوة خطوة وفقرة فقرة وتستمع بكل خطوة ، ولا يصلح العمل العشوائي اولا : تصميم الجداول بحاجة الى اعادة ضبط فني وعملي اليك بعض الملاحظات التي يجب العمل بها ، علما ان هذه الملاحظات عامة لا تخصك انت فقط تسمية الجدول : يجب ان تكون التسمية دليل على المحتوى ويفضل ان تبدأ التسمية بالبادئة tbl للجدول وللاستعلام qry وللنموذج frm وللتقرير rep فجدول الاصناف يمكن تسميته هكذا : tblItems أو tblAsnaf لاحظ حرف الكابتل عند بداية كلمة جديدة ، الحرف الكبير يساعد على قراءة الاسم بسهولة مثلا : tblAnnualBonuses tblAlshtrakatAlmonthya يمنع منعا باتا ترك مسافات بين الكلمات في التسمية الحذر من تسمية الكائنات والعناصر في قاعدة البيانات بكلمات محجوزة في اكسس وهذا رابط مساعد انظر الصورة ادناه حيث وقعت في المحذور في تسمية الحقلين عزيزي : هذه مقدمة ردا على تساؤلك الاخير فإن اعجبك سوف نستمر خطوة خطوة ونعمل تطبيق على كل خطوة

أولاً- للمرة الثانية أقول لك لا حاجة الى Select و Selection التي ترهق البرنامج دون فائدة خاصة ان الييانات كثيرة 40000 الف خلية (من G2 الى J10000 ) ثانياُ - اذا كنت تريدين مسح كل شيء يكفي كود من سطر واحد Sub ClearData() Sheets("Sheet1").Range("G2:L10000").Clear End Sub

وياحبذا لو وضعت لنا مرفقا صغيرا لنتمكن من التعديل عليه

وبعد قراءتي لطلبك بتمعن اكثر ، انت لا تريد 20 20 ، وانما تسلسل واحد ، ولكن مجموعات 🙂 هذا الكود يقوم بالعمل: Dim rst As DAO.Recordset Dim S As Integer Dim G As Integer Dim i As Integer Set rst = CurrentDb.OpenRecordset("Select * From all_data") S = 0 G = 1 'loop through the table Do Until rst.EOF S = S + 1 rst.Edit rst!OT_Seq = S rst!OT_Groups = G rst.Update 'If S = 20 Then 'Repeating 1-20 'S = 0 If Int(S / 20) = S / 20 Then 'No Repeat G = G + 1 End If rst.MoveNext Loop rst.Close: Set rst = Nothing MsgBox "Done" جعفر 1332.Report_Counter_20_ONLY.mdb.zip

اضفت الحقلين OT_Groups للمجموعة ، و OT_Seq للتسلسل ، الى الجدول ، التسلسل 1-20 ويتكرر لكل مجموعة ثم استخدمت الكود التالي لهذه الارقام: Dim rst As DAO.Recordset Dim S As Integer Dim G As Integer Dim i As Integer Set rst = CurrentDb.OpenRecordset("Select * From all_data") S = 0 G = 1 'loop through the table Do Until rst.EOF S = S + 1 rst.Edit rst!OT_Seq = S rst!OT_Groups = G rst.Update If S = 20 Then S = 0 G = G + 1 End If rst.MoveNext Loop rst.Close: Set rst = Nothing MsgBox "Done" جعفر 1332.Report_Counter_20_ONLY.mdb.zip

لعل هذا ما ما يناسبك فقط اشير أن الأرقام التسلسية في العمود A يجب ادخالها كأرقام وليس معادلة 1,2,3 وإذا كنت مصراً على المعادلات في العمود A أخبرني شكراً مع الإعتذار Sub test() Application.ScreenUpdating = False ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp" For Each sh In Worksheets If sh.Name <> "Main" And sh.Name <> "Temp" Then With Sheets("Main") lr = .Cells(Rows.Count, 16).End(xlUp).Row + 1 .Range("$A$2:$AQ$" & lr).AutoFilter Field:=16, Criteria1:=sh.Name Set rang = .Range("$A$2:$AQ$" & lr).SpecialCells(xlCellTypeVisible) rang.Copy Sheets("TEmp").Range("A1") .Cells.AutoFilter With Sheets("Temp") a = .Cells(1, 1).CurrentRegion .Cells(1, 1).CurrentRegion.ClearContents a = Application.Index(a, Evaluate("row(2:" & UBound(a) & ")"), Array(26, 30, "", 13)) End With With sh x = 1 For Each myArea In .Columns(1).SpecialCells(2, 1).Areas n = myArea.Count myArea.Offset(, 1).Resize(n, 4).Value = Application.IfError(Application.Index(a, Evaluate("row(" & x & ":" & _ x + n - 1 & ")"), Evaluate("column(" & [a1].Resize(, 4).Address & ")")), "") x = x + n Next End With End With End If Next Sheets("Main").Select Application.DisplayAlerts = flase Sheets("Temp").Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub Master (1).xlsm

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

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

تفضل على السريع يمكنك بناء تقاريرك على الجدول tbl1 db4.mdb

شكرا جزيلا اخي الفاضل علي ردك واهتمامك. جزاك الله خيرا كثيرا. والسلام ختام....

تفضل رمهان-التراجع-2003.rar

تضع هذه الاكواد لكل فورم الرئيسي والفرعي باستثناء الكود الاخير تضعه فقط على النموذج الرئيسي . هذا الكود تضعه في الفورم الرئيسي Private Sub Command13_Click() On Error GoTo Command13_Click_Err On Error Resume Next DoCmd.RunCommand acCmdSaveRecord If (MacroError <> 0) Then Beep MsgBox MacroError.Description, vbOKOnly, "" End If Command13_Click_Exit: Exit Sub Command13_Click_Err: MsgBox Error$ Resume Command13_Click_Exit End Sub وهذان تضعهم في الفرعي والرئيسي / الاخذ بعين الاعتبار اسماء الازرار Private Sub Form_Undo(Cancel As Integer) If bPreventClose Then Cancel = True End If End Sub Private Sub Form_Unload(Cancel As Integer) If bPreventClose = True Then Cancel = True End If bPreventClose = False End Sub Private Sub Form_BeforeUpdate(Cancel As Integer) Dim UserResp As Integer UserResp = MsgBox("انقر نعم للتراجع او لا للحفظ ... سيتم التراجع عن التغيير", vbYesNoCancel) Select Case UserResp Case vbNo Cancel = True Me.Undo bPreventClose = False Exit Sub Case vbCancel bPreventClose = True Cancel = True Exit Sub Case Else bPreventClose = False End Select End Sub

السلام عليكم ورحمة الله ايضا من الفرق الدالة vlookup تبحث في الصفوف الدالة Match تبحث في الصفوف او الاعمدة وفرق اخر الدالة vlookup تبحث قيمة واحدة الدالة Match تبحث عن قيمة واحدة او مجموعة من القيم -هنا لا تستخدم مع Index كمرجع للصف وفرق اخر الدالة vlookup تُرجع النتيجة كـ قيمة اما Match و Index تُرجع النتيجة كـ مرجع لذلك يمكن استخدام النتيجة لدوال تتطلب مرجعا فمثلا لو استخدمناها وسيطا للدالة ROW نحصل على رقم صف الخلية في امان الله

الاسم : محمد عمر الحضرمي سنة الميلاد : 1379هـ المهنة : موظف"الخطوط السعودية - جده " التعليم : بكارولويس إدارة أعمال كلية الادارة والاقتصاد جامعة الملك عبد العزيز 1405هـ الحالة الاجتماعية : متزوج ووالد لخمسه أبناء والكنية أبو ماجد بلد الجنسية / بلد الاقامة : السعودية / السعودية -جده أقسام الاهتمام فى المنتدي : الأكسيس معلومات أخري : حاصل على مجموعة دورات في الحاسب الالى ( أكسيس- وورد- أكسيل -بور بوينت -فوكس برو - سي ++ مشارك أساسي على مستوي المؤسسة في مشكلة عام 2000 هذا بالاضافة لمجموعة دورات إدارية في مجال العمل حاصل على دبلوم البرمجه اللغوية العصبية ) أجيد إستخدام الاكسس تم تنفيذ مجموعة من التطبيقات بإستخدام الاكسيس تستخدم داخل وخارج المؤسسة إقتراح للأستاذ محمد طاهر وجميع الاعضاء لكي يكون هناك تقارب ومحبة أكثر أقترح إضافة رقم أتصال للعضو ( جوال أو رقم ثابت ) يمكن الاتصال عليه عند زيارة بلد العضو ومقابلته شخصيا والتعرف عليه عن قرب . أفترض أن الاقتراح مقبول عليه رقم جوالى هو : 55647880-966 ( قبول الاتصال في أي وقت خلال 24 ساعة )

بسم الله الرحمن الحيم الاسم / عبد الرحمن احمد باسندوه طالب بجامعة ام القرى بكلية الشريعة بقسم المحاسبة العمر 27 سنة و نصف احب الاوفيس بجميع برامجه اجيد الوورد في اعماله العامة اجيد البور بوينت في اعماله العامة ايضا و نتمنى الفائدة منكم ونفيدكم فيما نعرف نفع الله بكم المسلمين

أخى الكريم المهندس محمد طاهر يعلم ربى أنى أنا قصدت المداعبة فقط فأنا أكن لك وللقائمين على هذا الموقع الرائع كل حب وتقدير ثانيا أمر التعارف هام جداً بين أعضاء المنتدى وذلك لما له من آثار إيجابية على جميع الأعضاء ثالثاً والأهم فقد أمرنا الله ورسوله بهذا التعارف وذلك لتأتلف هذه الأمة فهى أمة واحدة يجب أن يشعر بعضها ببعض ويجب أن نكون صفاً واحداً أمام أعدائنا وأولى هذه الخطوات أن نتعارف- تعارف دقيق - لنعرف الإمكانات والطاقات الكامنة فى هذه الأمة فقد يستفيد بعضنا من بعض رابعً أحب أن أعرفكم بنفسى الإسم أحمد سعيد إسماعيل أبوحجازة تاريخ الميلاد 5/9/1967 من مواليد قرية كرداسة بمحافظة الجيزة - مصر الموهل بكالوريوس تجارة شعبة محاسبة عام 1989 دبلوم درسات عليا فى المحاسبة والمراجعة من كلية التجارة جامعة القاهرة عام 1997 العمل أعمل محاسب رئيس قسم الأجور والمرتبات بشركة دريم لاند متزوج ولله عندى ثلاثة بنات ( وأتمنى أن تكون بناتى سبب فى دخولى الجنة )

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته الاسم : فيصل بن عوض الحربي سنة الميلاد : 1384 هـ المهنة : مشرف تشغيل محطات التحلية بالجبيل التعليم : الثانوية العامة ( القسم العلمي ) + دبلوم فني في تشغيل المحطات الحراريه الحالة الاجتماعية : متزوج و رزقني الله ب 6 أبناء ( 5 ذكور - وبنت واحده ) بلد الجنسية / بلد الاقامة : السعودية / السعودية أقسام الاهتمام فى المنتدي : كل الأقسام - و بالذات الأكسيس . معلومات أخري : أحب الأكسس و أنشأت تطبيقات مختلفة له. خبرتي فى المنتديات : مشرف قسم الأكسس فى الفريق العربي للبرمجة وعضو شرف في منتدى أوفيسنا . --------------------

الاسم : رضا عزت إبراهيم عقيل السن : 21.5 سنة التعليم : بكالوريوس تجارة الحالة الاجتماعية ،، متزوج البلد : مصر محافظة دمياط ،،، اعمل في مصر مدرس كمبيوتر في مركز تابع للتربية والتعليم وملكاً لعائلتي أقيم في المملكة العربية السعودية ،،، وأعمل بها مصمم في مطبعة (( أجيد ،، برامج التصميم ،، الأوفيس وخاصة الوورد )) والعديد من البرامج الخدمية الأخرى ....

الاسم : طارق حنيدق الحماحمى سنة الميلاد : 1962 م المهنة : مهندس مدني و أعمل فى مجال إدارة المشاريع الهندسية التعليم : بكارولويس هندسة مدنية 1984 - هندسة القاهرة الحالة الاجتماعية : متزوج و رزقني الله ب 4 أطفال بلد الجنسية / الاقامة : مصر / ح. المعادى أقسام الاهتمام فى المنتدي : الأكسيس و الإكسيل أجيد إستخدام برامج ادارة المشروعات مثل Primavera و Expedition بالاضافة الي بعض البرامج الهندسبة

الاسم : محمد طاهر سنة الميلاد : 1968 م المهنة : مهندس مدني و أعمل فى مجال إدارة المشاريع الهندسية التعليم : بكارولويس هندسة مدنية 1991 - هندسة القاهرة ماجيستير إدارة مشروعات 1998 - هندسة القاهرة PMP 2008 RMP 2012 MVP 2010-2013 الحالة الاجتماعية : متزوج و رزقني الله ب 4 أطفال بلد الجنسية / بلد الاقامة : مصر / الامارات أقسام الاهتمام فى المنتدي : كل الأقسام - و بالذات الأكسيس و الإكسيل معلومات أخري : أحب الأكسس و أنشأت تطبيقات مختلفة له ، و أيضا أحب جدا الاكسيل و استخدام ال vba به . تتركز خبرتي فى مجال ادارة المشاريع عموما و مشاريع التشييد بصفة خاصة، و لدى خبرة عملية فى هذا المجال من حيث التطبيق و التدريب. أجيد إستخدام برامج ادارة المشروعات بالاضافة الي بعض البرامج الهندسبة و أستخدم بعض برامج الرسم و الجرافيك بصورة متوسطة. و لدي دراية بسيطة بتصميم الويب و لغاته . خبرتي فى المنتديات : عضو شرف و مشرف قسمي الأكسس و الأوفيس ( سابقا ) و مراقب سابق فى الفريق العربي للبرمجة و إفتتحت هذا الموقع رسميا فى فى الثاني من جمادي الأولي 1424 هـ الموافق أول يوليو 2003 مـ