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

لكل عشاق الحديث في برمجة الأوفيس المتقدمة VBA يسعدني أن أقدم لكم شرح كود ترجمة جوجل 2019 في فيجوال بيسك للتطبيقات vba الموجودة ضمن حزمة ميكروسوفت أوفيس وسيكون الشرح على الأكسس microsoft access 2019 ومعالجة خطأ عدم ظهور الترجمة التعرف على أكواد لغات العالم world languages codes الموجودة في ترجمة جوجل وعددها 105 لغة التعرف على أسماء لغات العالم بالإنجليزية وباللغة العربية وباللغة المحلية لكل لغة دالة معرفة لإيقاف تنفيذ الكود فترة من الثواني wait مثل application.wait الموجودة في إكسل كتابة سطرين كود في سطر واحد نطق النصوص من خلال vba بجميع لغات العالم text to speech ترجمة سجلات الجداول أو الاستعلامات من خلال ADO وغيرها الكثيييييير اكتشفها بنفسك رابط القناة لمن لم يشترك معنا حتى الآن https://www.youtube.com/ostazmas2 #ostazmas ************ فتابعونا وقوموا بتفعيل زر الجرس للتنبيه وقت صدور الفيديو وعلق ولو بحرف لكي تدعمنا للاستمرار من أجلكم ********************* وفي هذه المرة لن أضع لكم الملف المستخدم في الشرح ولكن سأطلب ممن فهم الشرح أن يقوم بتطبيقه ويرفع لنا هنا ما تعلمه فعلا كنتيجة الفيديو ///////////////// وتذكر معي الحكمة القائلة: لا تعطني سمكة ولكن علمني كيف أصطاد

السلام عليكم ورحمة الله تعالى وبركاته اتمنى ان تكونو جمبعا بخير حال الموضوع اليوم قد وضحه العنوان كنت قد وعدت الاخوة فى هذا الموضوع ببعض التحديثات فوجدت ان كل هذه التحديثات يقدمها تطبيق واتساب اتجهت بفضل الله وكرمه الى محاكات نظام واتساب بالاكسس هذا الموضوع هدية لككم واتمنى ذكر الحقوق ان امكن ذلك والان مع الشرح اعتذر لرفعه على موقع خارجى لانتهاء المساحه هنا حجمة 2 ميجا فقط https://www.mediafire.com/file/ir1l91d6g18d8iy/AccessWatsapp.rar/file اتمنى التجربة واعلامى بالنتائج شكرا لكم

السلام عليكم و رحمة الله تعالى و بركاته إخوتي الكرام حياكم الله أقدم لكم برنامج إستخراج أسماء الملفات و المجلدات الفرعية داخل مجلد دور البرنامج : استخراج اسماء الملفات الفرعية داخل مجلد و فتح الملف عند النقر مرتين على اسمه. شرح البرنامج: 1 - اختر النوع الذي تريد إظهاره المجلدات فقط أم المجلدات و الملفات معا 2- اختر المجلد الذي تريد استعراض ملفاته. 3- اضغط على الزر استخراج الملفات لظهور أسماء الملفات داخل مربع النص. 4- عند الضغط المزدوج على اسم الملف أو المجلد يقوم البرنامج بفتحه. أدعوا لي و لوالدي بالتسهيل في قرعة الحج إن شاء الله هذا هو البرنامج استخراج اسماء الملفات الفرعية لمجلد.rar

وعليكم السلام اخى الكريم تم الحل بمعادلة معرفة وهى : Lookup_concat جمع التواريخ في خلية.xlsm

السلام عليكم تم عمل المطلوب في الملف المرفق بمعادلة طويلة نوعا ما... بالنسبة للأعمدة المخفية يكفي إخفاء عمود "المعدل" للمادة... مع العلم أن الدالة SOUS.TOTAL (أو SUBTOTAL) لا تقوم بعملها إلا باستعمال خاصية "التصفية" (Filter) -والتصفية لا تكون إلا للصفوف وليس للأعمدة- ولا تعمل باستعمال خاصية "الإخفاء"... بن علية حاجي Classeur1.xlsm

السلام عليكم ورحمة الله وبركاته بداية نشكر الأستاذ عبدالله باقشير الذى قدم لنا الدالة الشهيرة Kh_Father_Name لاستخراج اسم الاب كاملا من اسم الشخص العربى و ذلك بمساعدة الدالة Kh_Father_Replace ثانيا أقدم لكم الدالة المستحدثة MokhtarFamily تشبه دالة الاستاذ عبدالله فى العمل والخواص إلا إنها أشمل نوعا ما حيث تستطيع الدالة أن تقوم باستخراج الآتى 1- اسم الابن 2- اسم الاب 3- اسم الاب كاملا 4- اسم الجد 5- اسم الجد كاملا 6- اسم العائلة الصورة العامة للدالة ( MokhtarFamily (StrgName,NameNum,AcceptSingle تلاحظ أن الدالة تتكون من 3 بارامتر StrgName NameNum AcceptSingle البارامتر الاول نص اجبارى يحمل اسم الشخص الذى تتعامل معه البارامتر الثانى عدد اجبارى من 1 الى 4 1 لاستخراج اسم الابن 2 لاستخراج اسم الاب 3 لاستخراج اسم الجد 4 لاستخراج اسم العائلة أو اللقب البارامتر الثالث اختيارى بين قيمتين هما False و True فى كل الأحوال ناتج الدالة يكون اسما منفردا باستثناء True فى استخراج اسم الأب أو الجد فقط حيث تأتى باسم الأب أو الجد كاملا كود الدالة مع التعليقات Option Explicit Public Function MokhtarFamily(ByVal StrgName As String, ByVal NameNum As Integer, Optional AcceptNext As Boolean) As String ' Author : Mokhtar Hussein ' Release : 5 - 11 - 2016 Assuit Eygypt ' The MokhtarFamily is a new User Defined Function returns son's name or Father's name ' or Grandfather's name or Family's name of Arab person's name bases on a specific number. ' The MokhtarFamily udf takes into consideration the Arab complex names ' The Syntax : ' MokhtarFamily(StrgName,NameNum,AcceptNext) ' The MokhtarFamily function syntax has these named arguments: ' 1 - StrgName : Required String ' - The person's name which you are useing. ' 2 - NameNum : Required Integer ' - 1 to return the son's name. ' - 2 to return the Father's name ' - 3 to return the Grandfather's name ' - 4 to return the Family's Name . ' 3 - AcceptNext : Optional False or True ' - False to return all names in a Single form ' - True to return Father's name and Grandfather's name of fourfold Arab person's name ln a full form '-------------------------------------------------------------------------------------------------------------------------------------- ' الاعلان عن المتغيرات Dim TempName As String, SonName As String, Fname As String, GfName As String, FamilyName As String, Ipos As Integer Dim Sn As String, OtherNames As String, xName As String, xxName As String, xxxName As String, xxxxName As String, Arr, itm ' أضف هنا المقطع الأول ملحقا بفراغ أوالثانى مسبوقا بفراغ والتى تتكون منها الأسماء المركبة مثل عبد الرحمن أو المعتصم بالله Arr = Array("أبو ", "ابو ", "عبد ", "آل ", " الله", " الدين", " الإسلام", " الاسلام", " الهدى", " الحق", " النصر", " العهد", " النور", " بالله", " الزهراء", " كلثوم") ' ErrorHandlerفى حالة حدوث خطأ اذهب الى السطر الذى يبدأ بـ On Error GoTo ErrorHandler ' جعل الدالة حساسة لأى تغير فى الخلية التى تعمل عليها ' بمعنى أى تغير فى الخلية يتبعه تغير ناتج الدالة مباشرة Application.Volatile True ' التعامل مع الاسماء المركبة ' Arr حلقة تكرارية على كل اسم مركب فى المصفوفة For Each itm In Arr ' استبدال الفراغ بين المقطعين بشرطة واعتبارهما اسم واحد TempName = Replace(itm, " ", "_") ' وضع الشرطة فى كل اسم مركب يوجد باسم الشخص ' باستبدال أى اسم مركب به فراغ ' باسم مركب به شرطة بين مقطعيه StrgName = Replace(StrgName, itm, TempName) ' الانتقال الى الاسم التالى Next itm ' بالخطوة السابقة صار الاسم المركب اسما واحدا ' الخطوة التالية فحص المتغير الذى يحمل اسم الشخص ' هل المتغير فارغ أم أن هذا المتغير به اسم شخص ' اذا كان المتغير الذى يحمل اسم الشخص فارغا If IsEmpty(StrgName) Then 'فاذهب الى السطر GoTo ErrorHandler Else ' وان لم يكن المتغير فارغا يتم ' تخزين اسم الشخص فى متغير جديد ' مع حذف الفراغات فقط يمين و يسار اسم الشخص ' مع بقاء الفراغات الداخلية بين كل اسم واسم ' Trim وذلك يتم باستخدام الدالة Sn = Trim(StrgName) End If ' بالخطوة السابقة صار اسم الشخص جاهزا ' لاستخــراج الأسماء منه على التوالى منه 'وجود فراغ أو فراغات فى اسم الشخص معناه 'أن اسم الشخص مكون من اسمين فرعيين أوأكثر ' وعدم وجود الفراغ دليل على أنه اسم واحد ' ===== استخراج الاسم الأول أى اسم الابن ===== ' البحث عن موضع الفراغ الأول فى اسم الشخص ' InStr وهذا يتم باستخدام الدالة Ipos = InStr(Sn, " ") ' اذا كان الموضع = صفر If Ipos = 0 Then ' فإن اسم الشخص بدون فراغ وهذا يعنى ' أنّ اسم الشخص مكون فقط من اسم واحد ' وبالتالى المتغير الذى يحمل الاسم الاول ' تكون قيمته = اســــــــم الشخص xName = Sn ' أيضا المتغير الذى يحمل باقى الأسماء ' كاسم الأب و الجد و العائلة = لا شىء OtherNames = vbNullString ' اسم الابن قد يكون مركبا وبداخله شرطة ' للتخلص من الشرطة نضع بدلا منها فراغ SonName = Replace(Trim(xName), "_", " ") Else ' وان لم يكن الموضع = صفر فإن ' هذا معناه أن اسم الشخص به فراغ ' ومعناه أنه مكون من اسمين أو أكثر ' اسم الابن = الحروف التى تقع يسار اسم الشخص ' انتهاء بالحرف الذى يسبق الفراغ مباشرة xName = Left(Sn, Ipos - 1) ' أيضا المتغير الذى يحمل باقى الأسماء ' يساوى كل الحروف التى تقع يمين الفراغ مباشرة 'هذا المتغير نستخرج منه باقى الأسماء على التوالى OtherNames = Trim(Right(Sn, Len(Sn) - Ipos)) ' استبدال الشرطة فى اسم الابن المركب بفراغ SonName = Replace(Trim(xName), "_", " ") End If ' ===== استخراج الاسم الثانى أى اسم الأب ===== ' استخراج الاسم الثانى أو اسم الأب بنفس الكيفية السابقة ' لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الابن Ipos = InStr(OtherNames, " ") If Ipos = 0 Then xxName = OtherNames OtherNames = vbNullString Fname = Replace(Trim(xxName), "_", " ") Else xxName = Left(OtherNames, Ipos - 1) OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos)) Fname = Replace(Trim(xxName), "_", " ") End If ' ===== استخراج الاسم الثالث أى اسم الجد ===== ' استخراج الاسم الثالث أو اسم الجد بنفس الكيفية السابقة ' لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الأب Ipos = InStr(OtherNames, " ") If Ipos = 0 Then xxxName = OtherNames OtherNames = vbNullString GfName = Replace(Trim(xxxName), "_", " ") Else xxxName = Left(OtherNames, Ipos - 1) OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos)) GfName = Replace(Trim(xxxName), "_", " ") End If ' ===== استخراج الاسم الرابع أى اسم العائلة ===== ' استخراج الاسم الرابع أو اسم العائلة بنفس الكيفية السابقة ' لكن من المتغير الذى يحمل الأسماء التى تقع بعد اسم الجد Ipos = InStr(OtherNames, " ") If Ipos = 0 Then xxxxName = OtherNames OtherNames = vbNullString FamilyName = Replace(Trim(xxxxName), "_", " ") Else xxxxName = Left(OtherNames, Ipos - 1) OtherNames = Trim(Right(OtherNames, Len(OtherNames) - Ipos)) FamilyName = Replace(Trim(xxxxName), "_", " ") End If ' ===== النتائج المختلفة للدالة ===== ' اذا كان المتغير رقما ويساوى 1 If IsNumeric(NameNum) And NameNum = 1 Then ' ناتج الدالة = اسم الابن :الخروج من الدالة MokhtarFamily = SonName: Exit Function ' اسم الابن ' أيضا اذا كان المتغير رقما ويساوى 4 ElseIf IsNumeric(NameNum) And NameNum = 4 Then ' اسم العائلة أو اللقب ' ناتج الدالة = اسم العائلة :الخروج من الدالة MokhtarFamily = FamilyName: Exit Function End If ' اذا كان المتغير لا يساوى True If AcceptNext <> True Then ' و كان المتغير رقما ويساوى 2 If IsNumeric(NameNum) And NameNum = 2 Then 'ناتج الدالة = اسم الاب فقط :الخروج من الدالة MokhtarFamily = Fname: Exit Function ' واذا كان المتغير رقما ويساوى 3 ElseIf IsNumeric(NameNum) And NameNum = 3 Then ' ناتج الدالة = اسم الجد فقط :الخروج من الدالة MokhtarFamily = GfName: Exit Function End If: End If ' اذا كان المتغير لا يساوى False If AcceptNext <> False Then ' و كان المتغير رقما ويساوى 2 If IsNumeric(NameNum) And NameNum = 2 Then 'ناتج الدالة = اسم الاب كاملا باضافةالجد والعائلة ويفصل بينهم فراغ :الخروج من الدالة MokhtarFamily = Fname & Space(1) & GfName & Space(1) & FamilyName: Exit Function ' واذا كان المتغير رقما ويساوى 3 ElseIf IsNumeric(NameNum) And NameNum = 3 Then ' ناتج الدالة = اسم الجد كاملا باضافةالعائلة ويفصل بينهما فراغ MokhtarFamily = GfName & Space(1) & FamilyName: Exit Function End If: End If ' اعتبارا ناتج الدالة لا شىء فى حالة حدوث أخطاء ErrorHandler: MokhtarFamily = vbNullString End Function المرفق يوضح كيفية استخدام الدالة مباشرة على الخلايا و كيفية استدعاء الدالة بالكود أتمنى أن تكون الدالة مفيدة وتنال اعجابكم مع خالص تحياتى

مميزات الفورم السحرى 1-الفورم يستكشف جميع الجداول المصممة فى اى ملف اكسل 2- التعامل مع تلك الجداول من حذف واضافة وبحث وترحيل 4- ضبط عرض أعمدة اليست بوكس من خلال ضبط أعمدة الجدول 3- الفورم يكتشف المعادلات ويحميها تلقائيا 5- الفورم السحرى يكتشف اعمدة التواريخ تلقائيا 6- الفورم يقبل تدعيم الجداول بالصور تلقائيا 7- الفورم يحدد اوتوماتيكيا المكان الجغرافى للجداول داخل ملف الاكسل وهناك كثير للميزات ستكتشفها بنفسك عند العمل على الفورم السحرى هذا شرح مصور الاخ الرائع عماد الغازي بالمناسبة أشكره من كل قلبي على هذا الشرح جزاه الله خيرا الفورم_السحرى.rar

السلام عليكمأقدم لكم ملف يحتوي على دوال الإكسيل بـ 16 لغة مختلفة ، والملف مفيد في حالة التعامل مع نسخة غير النسخة الإنجليزية لمعرفة الاسم الصحيح للدالة https://www.file-upload.com/zpo9tygi69snتقبلوا وافر تقديري واحترامي

السلام عليكم و رحمة الله تفضل اخي علي ان شاء الله يكون حسب المطلوب يمكن تعديل علبه اخفاء "يشمل: 0 " في حالة عدم وجود سجلات مكررة H_R.zip

الله يرضى عليك تمام 100 % تسلم

السلام عليكم أخي الكريم با ريت ترفق مثال به المشكل لأن هذه الدالة تعمل معي حتى بأكثر من 10 مواقع و قد جربت هذا العدد 12345678912345 و قد تم تحويله بشكل جيد

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

Sub فهرس_الأحاديث() ' ' فهرس_الأحاديث Macro ' ' Dim refaat As Double refaat = InputBox("اكتب عدد الإشارات المرجعية") Dim x As Double x = 1 ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=2, NumColumns:= _ 2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _ wdAutoFitFixed With Selection.Tables(1) If .Style <> "شبكة جدول" Then .Style = "شبكة جدول" End If .ApplyStyleHeadingRows = True .ApplyStyleLastRow = False .ApplyStyleFirstColumn = True .ApplyStyleLastColumn = False .ApplyStyleRowBands = True .ApplyStyleColumnBands = False End With Selection.TypeText Text:="الحديث" Selection.MoveRight Unit:=wdCell Selection.TypeText Text:="الصفحة" Selection.MoveRight Unit:=wdCell For x = 1 To refaat Selection.InsertCrossReference ReferenceType:="إشارة مرجعية", _ ReferenceKind:=wdContentText, ReferenceItem:="H" & x, InsertAsHyperlink:= _ True, IncludePosition:=False, SeparateNumbers:=False, SeparatorString:= _ " " Selection.MoveRight Unit:=wdCell Selection.InsertCrossReference ReferenceType:="إشارة مرجعية", _ ReferenceKind:=wdPageNumber, ReferenceItem:="H" & x, InsertAsHyperlink:=True _ , IncludePosition:=False, SeparateNumbers:=False, SeparatorString:=" " Selection.MoveRight Unit:=wdCell x = x + 1 Next End Sub

تفضل تجربة.rar

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

وعليكم السلام -أهلا بك اخى الكريم فى المنتدى يمكنك الإستعانة بهذا البرنامج وكلمة السر للدخول للملف هى : 102030 وفيديو الشرح https://www.youtube.com/watch?v=ruZdfrjxgqQ تاريخ الشيكات1.xlsm

تفضل اخي العزيز حذفت بعض الصيانات من السيارات لا على التعيين حذفت زر (search) لاني افضل الضغط على زر انتر واذا لم يكن هو المطلوب وضح اكثر وستجدني ان شاء الله بالخدمة Test.accdb

السلام عليكم رجاءاً مراجعة الرابط لقد تمت الاجابة على سؤالك بالأمس ... تحياتي https://www.officena.net/ib/topic/87907-نقل-معلومات-من-جدول-الى-جدول-اخر/?do=findComment&amp;comment=555445

ماشالله قمة الابداع

السلام عليكم يبدو أنك تستخدم أوفيس 64 بت و عليك في هذه الحالة أن تضيف Ptrsafe قبل Function و سيعمل البرنامج إن شاء الله.

بارك الله فيك وجعله فى ميزان حسناتك

ما هذا ؟ كلَّ يومٍ تأتينا بجديد فريد . أبدعت و شببت عن طوق أكسس و vb6 و الأوفيس بأسره . شكراً لك و بوركت جهودكم و رزقك الله على قدر نيتك .

بارك الله فيك وحفظك الله

انظر المثال المرفق ......

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

وعليكم السلام-اهلا بك اخ كريم فى المنتدى تفضل تم عمل اللازم وتم عمل ترقيم تلقائى لرقم الفاتورة ايضا داخل الكود INVOICE CARGO.xlsm

السلام عليكم هذا نموذج فاتورة باللغة الفرنسية يمكن تعديلها حسب الحاجة( منقول للأمانة ) قمت بإزالة حماية VB فعند ظهور علبة الحوار اضغط OK دون كتابة شيء أرجو إفادة الجميع ____________1.rar

وعليكم السلام لك ما طلبت تحول التاريخ الى نص.xlsm

تفضل وعذرا على التاخير يتم الحدث بعد تحديث التاريخ الثاني بالتوفيق listbox (1).accdb

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته أسعد الله اوقاتكم احبتي في الله حوار من القلب إلى القلب هل جزاء الإحسان إلا .............. كلنا يعرف الكلمة المحذوفة من الآية الكريمة ولكن هل كلنا يطبقها؟! يقتطع الكثير من الأصدقاء جزءا من وقتهم وجهدهم للرد على استفسارات الأعضاء سواء بالتعديل على ملف أو إعطائه خلاصة خبرته أو بتسجيل فيديو للحل فهل استفاد أحدنا من هؤلاء الأصدقاء؟! أكيد نعم هل فكرت في مكافئتهم؟! ورد جميلهم؟! بصورة لا تجعلك تدفع ولا جنيه واحد؟! الجواب: أرجو أن أكافئهم ولكن كيف ؟! الجواب: عدم استعمال مانع الإعلانات add plock لأن مكسب صاحب المدونة أو القناة أو الموقع في ظهور الإعلانات والضغط عليها وفتحها (الضغطة = ١٠٠ ظهور) حتى إذا أغلقتها بعدها. لنا أن نتصور ماذا سيكون شعور الصديق المشارك في حل المشكلات التي تواجه أعضاء الجروب إذا وجد أن أصدقاءه يحاولون أن يفيدوه قدر استطاعتهم كما أفادهم بالطبع سيجتهد أكثر في الوقوف معهم وحل مشكلاتهم ويكون الإحسان من الطرفين دائما لا ينقطع إن شاء الله هل جزاء الإحسان إلا الإحسان ؟؟!!

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

وعليكم السلام لا ادري اذا كان هناك طريقة اخرى للمقارنة وجلب النتائج ، فطريقتي طويلة نوعا ما نعمل حقل نربط فيه رقم الصيدلية والشهر ، حتى نحصل على على مقارنة حسب طلبك (رجاء لاحظ اسماء الجداول في الاستعلام): . . نقارن بين الجدولين ، ونطلب جميع السجلات التي في الجدول store والتي قد لا توجد في الجدول الاخر . هنا حصلنا على السجلات التي لا توجد في الجدول الاخر (في المربعات الحمراء) ، وسنعمل نفس الشئ بالنسبة للجدول الثاني: . . . والان نريد ضم الاستعلامين مع بعض ن حتى نحصل على استعلام واحد . ومن نتائج الجمع ، نعمل استعلام اخير لتصفية السجلات الغير مرغوب فيها . والنتيجة ، لاحظ العمودين الذين على اليمين ، فكل عمود تابع لاحد الجداول: الحقل الذي فيه _ معناه انه لا يوجد سجل في الجدول (لاحظ اسم الجدول مسمى الحقل) . طبعا ستستخدم الاستعلام الاخير فقط في جلب النتائج واستعمالها ، والاستعلامات الاخرى هي لتهيئة السجلات بالطريقة المطلوبة جعفر 469.Order.accdb.zip

الأخ الحبيب أحمد مرجان نعتذر عن التأخير في تقديم المساعدة (وكل تأخيرة فيها عطلة للناس بس أكيد فيها خيرة بردو) إليك الكود التالي (وعشان غرامة التأخير مرفق شرح لكل أسطر الكود عشان تقدر تعدل بما يناسبك إن شاء الله) Sub ImportDataFromClosedWBUsingVLOOKUP() 'تعريف المتغيرات Dim WBK As Workbook Dim Rng As Range Dim LastRow As Long 'إيقاف تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إيقاف خاصية رسائل التنبيه Application.DisplayAlerts = False 'ليساوي المصنف المسمى 1 والموجود في نفس مسار المصنف الحالي [WBK] تعيين قيمة للمتغير 'يقوم هذا السطر أيضاً بفتح المصنف في المسار المذكور Set WBK = Workbooks.Open(ThisWorkbook.Path & "\1.xlsx") 'تعيين قيمة للنطاق المراد جلب البيانات منه من المصنف المسمى 1 Set Rng = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row) '[Sheet1] بدء التعامل مع المصنف الحالي في ورقة العمل With ThisWorkbook.Sheets("Sheet1") 'تحديد رقم صف آخر خلية بها بيانات في العمود الأول LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 'وضع معادلة دالة البحث في العمود الثاني والحصول على النتيجة من العمود الثاني في المصنف 1 With .Range("B2").Resize(LastRow - 1) .Formula = "=IFERROR(VLOOKUP(A2," & Rng.Address(, , , True) & ",2,False),"""")" .Value = .Value End With 'وضع معادلة دالة البحث في العمود الثالث والحصول على النتيجة من العمود الثالث في المصنف 1 With .Range("C2").Resize(LastRow - 1) .Formula = "=IFERROR(VLOOKUP(A2," & Rng.Address(, , , True) & ",3,False),"""")" .Value = .Value End With End With 'إغلاق المصنف المأخوذ منه البيانات بدون حفظ WBK.Close SaveChanges:=False 'إعادة تفعيل خاصية رسائل التنبيه Application.DisplayAlerts = True 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub وبكدا نكون دفعنا غرامة التأخير والحمد لله تقبل تحياتي Import Data From Closed WB Using VLOOKUP YasserKhalil.rar

اخى احمد هل تقصد هكذا تقبل تحياتى 1.rar

نم تحويل الكود على فورم الاكسل المرفق 2003 SystemInfo.rar

أخي الكريم سعيد بيرم جزاك الله خيرا على ما تقدم لخدمة العملية التعليمية .... وبملاحظة ما ذكرته سابقاً ملاحظة دقيقة نجد أننا لدينا 4 متغيرات: الأول : الأساسي الثاني: المدة باليوم سواء بأجر كامل أو بنسبة الثالث : عدد الفترات بمعنى أنه من عمل جزء من العام بأجر كامل وجزء بنسبة فعدد فتراته 2 وهكذا الرابع : نسبة الأجر ..... أما موضوع تواريخ الإخلاء وخلافه فلا يهم إلا لمعرفة المدة وهذا يمكن عمله يدويا أو في ملف آخر ..... وبناء على فهمي لما سبق قمت بعمل نموذج بسيط يقوم بكل الاحتمالات: إذا كان الموظف طبيعي ضع له في المدة 180 وعدد الفترات 1 والنسبة 100 فسيتم حساب مكافأته بصورة طبيعية وإذا كان بنسبة لفترة واحدة طوال العام ضع له في المدة 180 وعدد الفترات 1 والنسبة التي يتقاضاها سواء 100 أو أقل سيتم كذلك حساب مكافأته وايضا إذا كان عمل بأجر كامل لمدة 60 يوم والباقي بنسبة فهذا ما تم عرضه في المثال أتمنى أن يكون قد وفقني الله في الوصول للمطلوب ... ويسعدني تواصلك وتواصل الجميع معنا في هذا الموضوع وكل عام والجميع بكل خير mas_sample.rar

بارك الله فيك أخي سعيد ونفع بك وجزاك الله كل الخير في الدنيا والآخرة