omar elhosseini

اخي ليس هذا ما اقصد الكود طويل علي التتبع احكي لي الخطوات خطوة خطوة بعيد عن الاكسيل لان الموضوع والكود غير مفهوم لي احكي لي هكذا بعيدا عن الاكسيل مثلا : 1- افتح ملف AO 2- انسخ اول شيت الي ورقة جديدة في ملف prog 3- افعل كذا 4-- افعل كذا هكذا اخي حتي اساعدك

شاهد المرفقات Test_1.xls

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

قمت بتجربة البرنامج علي اكثر من 1000 معلم لا يوجد اي بطئ نهائيا قد يكون البطئ من الملف نفسه والأكواد الأخري شاهد الفيديو Video_1.rar

تحت امرك اخي لم يكن هناك اي ازعاج تحياتي لك

الأخ hesham monzer1 ضع اسم الشيت المراد حفظها في اول سطر من الكود بدلا من ( ورقة1 ) Const Sh_Name = "ورقة1" Sub finish() ' Dim FileExtStr As String Dim FileFormatNum As Long Dim xWs As Worksheet Dim xWb As Workbook Dim FolderName As String Application.ScreenUpdating = False Set xWb = Application.ThisWorkbook DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") FolderName = xWb.Path & "\" & xWb.Name & " " & DateString MkDir FolderName For Each xWs In xWb.Worksheets If xWs.Name = Sh_Name Then xWs.Copy If Val(Application.Version) < 12 Then FileExtStr = ".xls": FileFormatNum = -4143 Else Select Case xWb.FileFormat Case 51: FileExtStr = ".xlsx": FileFormatNum = 51 Case 52: If Application.ActiveWorkbook.HasVBProject Then FileExtStr = ".xlsm": FileFormatNum = 52 Else FileExtStr = ".xlsx": FileFormatNum = 51 End If Case 56: FileExtStr = ".xls": FileFormatNum = 56 Case Else: FileExtStr = ".xlsb": FileFormatNum = 50 End Select End If xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum Application.ActiveWorkbook.Close False End If Next MsgBox "You can find the files in " & FolderName Application.ScreenUpdating = True ' End Sub

شاهد المرفقات Test_3.xls

الأخ عبدالله نبها شاهد المرفقات Test_1.rar

الملف بالمسار الخاص بك Test_21.xls

هل قمت بتمكين الماكرو كما في الصور التالية

اليس هذا هو ترحيل ملخص الفواتير ام تقصد شئ اخر المرفقات مره اخري Test_2.xls

شاهد المرفقان Test_1.rar

شاهد المرفق Sub Auto_Open() ' Application.AskToUpdateLinks = False ' End Sub هذا هو التعديل اذا لم تكن شاهدته رئيسي.xlsm

شاهد المرفق Test_3.xls

الأخ وائل عبد الصمد شاهد المرفقات Test_1.rar

الأخ وائل عبد الصمد هل هناك طلبات اخري حتي يتم عمل حسابها في الكود

تم التعديل المرفقات Test_2.rar

الاخ bachiri401 اخي العزيز الكود يقوم بالمهمتين : 1- منع اللصق اذا لم تتطابق القيم مع البيانات في القائمة المنسدلة 2- السماح باللصق اذا تتطابقت القيم مع البيانات في القائمة المنسدلة الكود يقوم بالمهمتين الكود يقوم بالمهمتين الكود يقوم بالمهمتين برجاء من بعض الأخو تجربة الملف Test_2.xlsm في المشاركة الرابعة واخبار اخونا الاخ bachiri401 بالنتيجة الكود يقوم بالمهمتين الكود يقوم بالمهمتين الكود يقوم بالمهمتين

الاخ bachiri401 لايمكن حدوث اللصق للقيم غير مطابقة للتحقق من صحة البيانات الأ اذا كان جهازك ونسختك احدهم غير سليم افحص جهازك ونسختك جيدا ربما تم التلاعب بقيم بعض الريجستير ارجو من بعض الأخو تجربة الملف Test_2.xlsm في المشاركة الرابعة واخبار اخونا الاخ bachiri401 بالنتيجة اخي شاهد الفيديو وتأكد من ان ( لايمكن حدوث اللصق للقيم غير مطابقة للتحقق من صحة البيانات ) شاهد الفيديو المرفق Video_1.rar

مرحبا اخي احمد بدره هذا صحيح اخي وسليم 100% ولكن هل نستطيع تحقيق هذا الشرط بدون ظهور رسالة في غير محلها اعتقد لا في طريقتك الشق الاول وهو ( منع اللصق عند عدم تطابق القيم مع قيم القائمة المنسدلة ) يمنع اللصق مع رسالة بذلك وهذا سليم الشق الناني وهو ( السماح للصق عند تطابق القيم مع قيم القائمة المنسدلة ) يسمح باللصق ولكن مع اول كيليك في خلايا التحقق بعد السماح باللصق تطهر رسالة المنع وهي رسالة في غير محلها انظر الصورة بعد السماح للصق مع اول كليك في خلايا التحقق تحياتي اخي

الاخ emam1424 شاهد المرفقات Test_1.rar

اللهم امين ولك مثله

شاهد المرفق بدلا من الوقوف علي الرقم في العمود ( A ) اختار الرقم من القائمة في الخلية ( N1 ) والباقي كما طلبت تماما المرفق Tester.rar

الاخ bachiri401 كيف لا اخي هو يمنع اللصق تماما راجع الملف الاول ثم اخبرني من فضلك علي العموم شاهد المرفق تم منع اللصق عند عدم تطابق القيم مع قيم القائمة المنسدلة Test_2.xlsm

الاخ ميلاد طارق يجب اختيار الرقم من القائمة في الخلية( N1 ) شاهد المرفق Test_1.xls