حسونة حسين

السلام عليكم ورحمه الله وبركاته وبها نبدأ الملف ليس به اي بيانات وهو ايضا ليس بملف اوفيس حاول تعمل ريكوفر باي برنامج ريكفر لعل وعسي تجد نسخه سليمة هذا رابط برنامج Active Partition Recovery Professional 15.0.0 Portable لعله يفيدك ان شاء الله

المنتدي تعليمي لا يقدم برامج جاهزة يمكنك عمل ملف بطلبك والنقطه التي تتوقف فيها يمكنك السؤال عنها وستجد ان شاء الله من يفيدك

تفضل اخي مثال للتوضيح.xlsb

اخي @أبو أحمد الاجابه التي قدمها لك @أ / محمد صالح لو ركزت فيها ستجد انها تفي بطلبك تماما الاستاذ محمد كاتب لك ActiveSheet.Unprotect "password" Range("C3:E3").Merge 'Selection.Merge ActiveSheet.Protect "password" كل ما عليك ان تجعله كالتالي ActiveSheet.Unprotect "password" Selection.Merge ActiveSheet.Protect "password" وتحدد الخلايا المراد دمجها ثم تعمل تشغيل للكود وسوف يتم دمج الخلايا بلا عناء ولا تعب

وعليكم السلام ورحمة الله وبركاته موضوع مكرر موجود في قسم الوورد Word

وعليكم السلام ورحمه الله وبركاته جرب هذا التعديل 1- فورم واحد للبحث عن جميع الاذون سواء اضافة او صرف او ارتجاع 2- فورم واحد للتسجيل جميع الاذون سواء اضافة او صرف او ارتجاع 3-تم الاستغناء عن فورم الاكواد 900.xlsm

حول الجدول الي نطاق عادى وسوف يعمل الكود بلا مشاكل

النسبه ٢٠ % من اجمالي التوريد =IF(V1<AD1;V1*0.2;IF(V1>=AD2;V1*0.25;IF(V1>=AD3;V1*0.27)))-V2 ام من ال ٣٤٥٠٠ =IF(V1<AD1;AD1*0.2;IF(V1>=AD2;AD2*0.25;IF(V1>=AD3;AD3*0.27)))-V2

ما البيان الذي كتبته حتي يعطيك هذا الخطأ

السلام عليكم ورحمه الله وبركاته موضوع مكرر تم غلق الموضوع

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

اخى @محمود الطحاوي جرب هذ التعديل متابعة8.xlsm

بارك الله فيك أخي @أبوأحـمـد

وعليكم السلام ورحمه الله وبركاته اخي اقرأ الموضوع جيدا وسوف تجد الملف

تفضل اخي جرب هذا التعديل الفولدر المسمي صور الموظفين لابد ان يكون موجود بجوار هذا الملف ادخال بيانات اطفال الروضة حضانة.xlsm

وعليكم السلام ورحمة الله وبركاته جرب هذا التعديل اخي @mohamed.youssef جرب هذا التعديل اخى @mohamedyousef ويرجي اخي عدم تكرار المواضيع تم حذف جميع المواضيع المكرره اخي ان استبطأت الرد من اخوتك يكفي ان تكتب مشاركه في نفس الموضوع مثلا للرفع او توضح شيئا ممكن ان يكون غامض تم تعديل فورم ١ ١- تم اضافه كومبوكس تختار منه اضافة او صرف او ارتجاع ٢- تم حذف التيكست بوكس الخاصه بتسجيل الصرف والارتجاع وزر الامر الخاص بهم والابقاء على التيكست بوكس الخاص ب الاضافه ٣- ووضع زر لتسجيل كل الحركات سواء كان اضافه او صرف او ارتجاع كل ما عليك ان تختار من الكومبوكس ما تريد سواء اضافة او صرف او ارتجاع والضغط علي زر تسجيل الكل واخبرنى بالنتائج هل صحيحه ام لا شكلي كده طولت عليك تفضل الملف في المرفقات تعديل بسيط.xlsm

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

اخى بنسخ الكود مره اخرى به تعديل بسيط ليتفادى مشكله عدم وجود شيت باسم reservation

قم بحذف جميع السطور من بدايه السطر ١٠ الي نهايه الشيت لان بها خلايا مدمجه مثل الصورة

وعليكم السلام ورحمه الله وبركاته تفضل اخي ياسر @yasse.w.2010 تعديل بسيط على كودك وتم اضافه شرط ان لم يكن يوجد صفحه بالاسم الذي تريد ان لا يعطى خطأ ويفتح الملف التالي Sub information() Dim wb As Workbook, WS As Worksheet, lr1 As Integer, lr2 As Integer Dim fil As Variant, dat As Long Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("Temp") Application.ScreenUpdating = False ''' غلق اهتزاز الشاشه Application.DisplayAlerts = False ''' غلق اي رساله تظهر مثل الحفظ الخ lr1 = sh.Cells(Rows.Count, 1).End(xlUp).Row ''' ار صف فيه بيانات في العامود الاول sh.Range("A10:k" & lr1 + 1).ClearContents '''مسح البيانات في هذا النطاق INF = ThisWorkbook.Path '''مسار الملف fil = Dir(INF & "\*.xl??") ''' مسار الملف في اي مكان Do While fil <> "" ''' المرور على كل الملفات If fil <> "DATA.xlsm" Then ''' اسم الملف الذي لا يتم جلب البيانات منه Set wb = Workbooks.Open(INF & "\" & fil) ''' فتح الملففات من المسار lr1 = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ''' تحديد مكان نسخ الخلايا If Not IsError(Evaluate("ISREF('[" & wb.Name & "]" & "reservation" & "'!A1)")) Then Set WS = wb.Worksheets("reservation") lr2 = WS.Cells(Rows.Count, 2).End(xlUp).Row ''' تحديد عامود اخر خليه بها بيانات ليتم نسخها WS.Range("A8:k" & lr2).Copy '''نسخ البيانات من الملف الى ملف اخر sh.Range("a" & lr1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False dep = Left(wb.Name, Application.Search(".", wb.Name) - 1) ''' تحديد اسم اسم الملف و الغاء الامتداد الخاص بالملف sh.Range("h" & lr1 & ":h" & lr1 + lr2 - 8) = dep ''' مكان اسم الملف End If wb.Close ''' غلق الملف End If fil = Dir ''' تكرار الملفات Loop Application.DisplayAlerts = True ''' فتج اهتزاز الشاشه Application.ScreenUpdating = True ''' فنح رسائل الحفظ End Sub

السلام عليكم ورحمه الله وبركاته تفضل اخى Private Sub CommandButton1_Click() Dim X X = Application.Match(TextBox1, Sheet1.Columns(3), 0) If IsError(X) Then MsgBox "الكود غير موجود" End If End Sub

ربنا يبارك فيك استاذ @محمدي عبد السميعويحفظك يارب العالمين ويديم عليك الصحه وفيك بارك اخى محمد @spyhearts

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

السلام عليكم وبها نبدأ بعد اذن استاذ @أ / محمد صالح استخدم هذه المعادله لان اسم الصفحه عندك يوجد بها مسافه =IFERROR(INDEX(INDIRECT("'"&$B$1 &"'!$B$2:$B$1000");MATCH(A3;INDIRECT("'"&$B$1 &"'!$A$2:$A$1000");0));"")

يمكنك الاستفاده من هذا الموضوع