kh34d قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 (معدل) السلام عليكم اخواني الكرام بعد اذنكم انا عايز ارحل الفاتورة المرفقه من الصفحه الاساسيه ( invoice) والمخصصه لعمل الفواتير. الي الصفحه الثانيه( recycle) وهي صفحه اجمع فيها كل الفواتير السابقه توضيح:- الصفحه الرئيسيه بها( فاتورة واحده ثابته) بها 16 صف ثابتين لا يذيدوا ولا يقلوا ولكن لا يتم ملء جميع الصفوف بالطبع....فهذا حسب حالة البيع انا عندي كود للطباعه >>> يقوم باخفاء الصفوف الفارغه ثم يقوم بالطباعه المطلوب >>> كود للترحيل بالمتطلبات الاتيه :- بالترتيب الاتي 1- ان يكون الماكرو ( بداخل صفحة invoice ) ويقوم بفك الحمايه لصفحة الفاتوره ( invoice) برقم سري 11 2- لو فيه بيانات في خانة التاريخ او عمود الكميات يتم الترحيل وتظهر رساله تفيد ذلك ولو مش موجوده البيانات لا يتم الترحيل وتظهر رساله بذلك. 3- يتم نسخ الفاتورة كما هي ( جدول به البيانات فقط ) بدون نسخ الالوان او المعادلات>>> وبدون نسخ الصفوف المخفيه بل حذفها>>>هام جدا . الي الصفحه المرحل لها....علما بان المدي المراد نسخه هو (a5:m27) من الصفحه الاساسيه. 4- يتم اختيار خانه معينه ولتكن (a3) في الصفحه الثانيه ( المرحل اليها) ويتم النسخ فيها دائما بمعني ان تكون الفاتورة الجديده المرحله فوق الفواتير القديمه. 5- بعد ذلك يتم الوقوف في خانة (b26) في الصفحة الرئيسيه ثم مسح خانة (التاريخ وعمود الكميات) فقط....ثم ذيادة رقم الفاتورة + 1 6- اظهار الصفوف الفارغه في الفاتورة بالصفحة الرئيسيه . 7- حماية الورقه مره اخري برقم سري 11 8- طلب خاص:- اكون شاكر لو تم ادراج كود ( شريط التقدم).... يعمل اثناء تنفيذ الماكرو ككل ... VBA Progress Bar UserForm لاني حاولت اعمله لكن لم ينجح معي بان يكون نفس مدة تنفيذ المتكرو بيانات الملف المرفق:- الصفحه الاولي الرئسيه بها فاتورة واحدة فقط رقمها 4 علي سبيل المثال ...ويتم العمل عليها دائما ....والمراد ترحيلها الصفحه الثانيه بها 3 فواتير ارقام 1و2و3 ...الفاتورة رقم 3 هي الاحدث ... ولذلك فالفاتورة الاساسيه ذياده +1= 4 ارجوا ان اكون شرحت المطلوب شرحا وافيا ليس فيه لبس.... وجزاكم الله خيرا فاتورة.rar تم تعديل أغسطس 19, 2017 بواسطه kh34d
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 السلام عليكم جرب الكود التالي عله يفي بالغرض .. في ورقة العمل المسماة recycle اجعل عنوان أول فاتورة موجودة في الصف رقم 3 عند التعامل مع ورقة العمل invoice تأكد أن كلمة السر مفعلة .. ولكن قبل ذلك يجب أن تقوم بتغيير خصائص خلايا الإدخال (التاريخ وعمود الكميات) ، وذلك عن طريق تحديد الخلايا ثم كليك يمين ثم Format Cells ثم التبويب Protection وأزل علامة الصح بجانب الخيار Locked .. بحيث تتمكن من عملية الإدخال والورقة محمية الآن بعد ضبط أوراق العمل جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim rg As Range Application.ScreenUpdating = False Set ws = Sheets("invoice") Set sh = Sheets("recycle") Set rg = ws.Range("A5:F26").SpecialCells(xlCellTypeVisible) ws.Protect Password:="11", AllowFormattingRows:=True, UserInterfaceOnly:=True, Contents:=True, Scenarios:=True, DrawingObjects:=False If IsEmpty(ws.Range("D7")) Or Application.WorksheetFunction.CountA(ws.Range("D10:D25").SpecialCells(xlCellTypeVisible)) = 0 Then MsgBox "No Data", vbCritical: Exit Sub sh.Rows(3).Resize(rg.Rows.Count + 3).Insert Shift:=xlDown rg.Copy: sh.Range("A3").PasteSpecial xlPasteValues rg.Copy: sh.Range("A3").PasteSpecial xlPasteFormats sh.Range("A7").CurrentRegion.Interior.Color = xlNone ws.Range("D7").ClearContents ws.Range("D10:D25").SpecialCells(xlCellTypeVisible).ClearContents ws.Range("D5").Value = ws.Range("D5").Value + 1 rg.EntireRow.Hidden = False Application.Goto ws.Range("A26") Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub إذا أدى الكود الغرض لا تنسى الإعجاب وتحديد أفضل إجابة ليظهر الموضوع منتهي تقبل تحياتي 1
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 (معدل) 48 دقائق مضت, ياسر خليل أبو البراء said: السلام عليكم جرب الكود التالي عله يفي بالغرض .. في ورقة العمل المسماة recycle اجعل عنوان أول فاتورة موجودة في الصف رقم 3 عند التعامل مع ورقة العمل invoice تأكد أن كلمة السر مفعلة .. ولكن قبل ذلك يجب أن تقوم بتغيير خصائص خلايا الإدخال (التاريخ وعمود الكميات) ، وذلك عن طريق تحديد الخلايا ثم كليك يمين ثم Format Cells ثم التبويب Protection وأزل علامة الصح بجانب الخيار Locked .. بحيث تتمكن من عملية الإدخال والورقة محمية الآن بعد ضبط أوراق العمل جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim rg As Range Application.ScreenUpdating = False Set ws = Sheets("invoice") Set sh = Sheets("recycle") Set rg = ws.Range("A5:F26").SpecialCells(xlCellTypeVisible) ws.Protect Password:="11", AllowFormattingRows:=True, UserInterfaceOnly:=True, Contents:=True, Scenarios:=True, DrawingObjects:=False If IsEmpty(ws.Range("D7")) Or Application.WorksheetFunction.CountA(ws.Range("D10:D25").SpecialCells(xlCellTypeVisible)) = 0 Then MsgBox "No Data", vbCritical: Exit Sub sh.Rows(3).Resize(rg.Rows.Count + 3).Insert Shift:=xlDown rg.Copy: sh.Range("A3").PasteSpecial xlPasteValues rg.Copy: sh.Range("A3").PasteSpecial xlPasteFormats sh.Range("A7").CurrentRegion.Interior.Color = xlNone ws.Range("D7").ClearContents ws.Range("D10:D25").SpecialCells(xlCellTypeVisible).ClearContents ws.Range("D5").Value = ws.Range("D5").Value + 1 rg.EntireRow.Hidden = False Application.Goto ws.Range("A26") Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub إذا أدى الكود الغرض لا تنسى الإعجاب وتحديد أفضل إجابة ليظهر الموضوع منتهي تقبل تحياتي استاذي العزيز ...الكود اكثر من رائع...بارك الله فيك ولكن استحملني معلش ...هناك بعض الملاحظات:- 3- المدي المراد نسخه هو (a5:m27) من الصفحه الاساسيه invoice <<< ( مع العلم بان الاعمدة من H وحتي M مخفيه وبها بيانات واريد اظهارها هذه المره >>بعد الترحيل في الصفحه الثانيه recycle بعكس ما سبق بخصوص الصفوف المخفيه 6- اظهار الصفوف الفارغه في الفاتورة بالصفحة الرئيسيه invoice <<<< (هذا الطلب لا يعمل.. فالصفوف مخفيه كما هي ولم تظهر في الصفحه الرئيسيه ) 8- طلب خاص:- اكون شاكر لو تم ادراج كود ( شريط التقدم).... يعمل اثناء تنفيذ الماكرو ككل ... VBA Progress Bar UserForm لاني حاولت اعمله لكن لم ينجح معي بان يكون نفس مدة تنفيذ الماكرو <<< ( هذا الطلب غير موجود بالكود) *** لم افهم هذا الجزء ( في ورقة العمل المسماة recycle اجعل عنوان أول فاتورة موجودة في الصف رقم 3 ) فانا اريد ارقام الفواتير في recycle كما هي بالتسلسل الطبيعي لها في عملي...لاني بعمل بحث بعد كدا علي ارقام الفواتير *** ارجوا ان لا اكون اثقلت عليك وشكرا جدا جدا علي تعبك معايا تم تعديل أغسطس 19, 2017 بواسطه kh34d
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 من الأفضل تناول نقطة نقطة لأني لا أملك الوقت الآن للعمل على كل النقاط مرة واحدة .. والأفضل إرفاق ملف معبر عن المطلوب كما أخبرتك من قبل الآن تغيرت هيكلة الملف ويوجد تفاصيل جديدة غير موجودة في الملف الأول سأجيبك على نقطة واحدة فقط ألا وهي الصفوف المخفية .. قم باستبدال كلمة rg في السطر التالي rg.EntireRow.Hidden = False بهذه الكلمة ws.Range("A5:F26") كما يفضل أن يكون لكل طلب موضوع مستقل لتجد استجابة أفضل من الأعضاء بالمنتدى تقبل تحياتي 2
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 (معدل) 20 دقائق مضت, ياسر خليل أبو البراء said: من الأفضل تناول نقطة نقطة لأني لا أملك الوقت الآن للعمل على كل النقاط مرة واحدة .. والأفضل إرفاق ملف معبر عن المطلوب كما أخبرتك من قبل الآن تغيرت هيكلة الملف ويوجد تفاصيل جديدة غير موجودة في الملف الأول سأجيبك على نقطة واحدة فقط ألا وهي الصفوف المخفية .. قم باستبدال كلمة rg في السطر التالي rg.EntireRow.Hidden = False بهذه الكلمة ws.Range("A5:F26") كما يفضل أن يكون لكل طلب موضوع مستقل لتجد استجابة أفضل من الأعضاء بالمنتدى تقبل تحياتي بارك الله فيك ولكن ان ما ذكرته لك من تعديل هو كان مطلوب منذ الوهله الاولي....؟؟ الا موضوع الاعمده المخفيه وهو تكمله كانت موجوده عندي ...ولم اذكرها علي انها غير مهمه....اعتقد انها تتطلب تغير المدي واظهارها بشكل ما وسوف اصبر مع حضرتك عندما يكون لديك وقت ان تحل نقطه نقطه ...لانه كود واحد متكامل ...وصعب انه يكون علي عدة مواضيع تم تعديل أغسطس 19, 2017 بواسطه kh34d
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 يمكن أن يطرح موضوع جديد من بداية جديدة ..لا مشكلة في ذلك أي تطرح الموضوع وترفق ملف وبه آخر ما استجد في الكود فيه وتشرح المطلوب عليه حتى يشارك الجميع ... عموماً ما هي النقطة التالية التي يجب معالجتها الآن واشرح بالتفصيل .. لأفهم المشكلة لديك آخر نقطة تحدثنا بها وهي إظهار الصفوف المخفية بعد الترحيل وقد وجهتك لتغيير النطاق من rg إلى A2:F26 >> فهل قمت بحل هذه النقطة أم لا؟
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 (معدل) 12 دقائق مضت, ياسر خليل أبو البراء said: يمكن أن يطرح موضوع جديد من بداية جديدة ..لا مشكلة في ذلك أي تطرح الموضوع وترفق ملف وبه آخر ما استجد في الكود فيه وتشرح المطلوب عليه حتى يشارك الجميع ... عموماً ما هي النقطة التالية التي يجب معالجتها الآن واشرح بالتفصيل .. لأفهم المشكلة لديك آخر نقطة تحدثنا بها وهي إظهار الصفوف المخفية بعد الترحيل وقد وجهتك لتغيير النطاق من rg إلى A2:F26 >> فهل قمت بحل هذه النقطة أم لا؟ نعم تم حل المشكله...شكرا لك النقطه التاليه هي:- 3- المدي المراد نسخه هو (a5:m27) ككل من الصفحه الاساسيه invoice مع العلم بان جزء من ذلك المدي ( h5:m27 )مخفي وبه بيانات واريد اظهارها هذه المره >>بعد الترحيل في الصفحه الثانيه recycle بعكس ما سبق بخصوص الصفوف المخفيه بمعني اخر :- ترحيل الظاهر فقط من الصفوف في المدي a5:f27 مع ترحيل المخفي من الصفوف في المدي h5:m27 تم تعديل أغسطس 19, 2017 بواسطه kh34d
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 تفضل المرفق التالي .. وإذا لم يكن المطلوب وضح اكثر بملف مرفق من عندك إذ أني أخبرتك أني لا أعمل على التخمين وفيه نقطة مهمة لابد من العلم بها أنه طالما الصفوف مخفية في النطاق A2:F27 فلا يمكن أن تظهر نفس الصفوف في النطاق H2:M27 وإنما ما يمكن إظهاره وإخفاؤه هو الأعمدة نفسها من H إلى M عموماً المرفق عدلت فيه قليلاً حيث قمت في ورقة الـ recycle بحذف صفوف فارغة بحيث تبدأ البيانات من أول الصف الثالث (لأنك سألت عن تلك النقطة من قبل) وقمت بفك الحماية عن عمود الكميات وخلية التاريخ بحيث تتمكن من الإدخال والورقة محمية فاتورة.rar 1
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 20 دقائق مضت, ياسر خليل أبو البراء said: تفضل المرفق التالي .. وإذا لم يكن المطلوب وضح اكثر بملف مرفق من عندك إذ أني أخبرتك أني لا أعمل على التخمين وفيه نقطة مهمة لابد من العلم بها أنه طالما الصفوف مخفية في النطاق A2:F27 فلا يمكن أن تظهر نفس الصفوف في النطاق H2:M27 وإنما ما يمكن إظهاره وإخفاؤه هو الأعمدة نفسها من H إلى M عموماً المرفق عدلت فيه قليلاً حيث قمت في ورقة الـ recycle بحذف صفوف فارغة بحيث تبدأ البيانات من أول الصف الثالث (لأنك سألت عن تلك النقطة من قبل) وقمت بفك الحماية عن عمود الكميات وخلية التاريخ بحيث تتمكن من الإدخال والورقة محمية فاتورة.rar وربنا يكرمك يا رب انا الان في طريقي للبيت بإذن الله... وعندما اصل سوف اطبق الملف الجديد بتاع حضرتك. النقطه التاليه:- عمل شريط التقدم... بحيث عند تنفيذ هذا الكود لا تظهر شكل الساعه الرملية العاديه لتنفيذ الأمر.... ولكن يظهر progress bar من 1%حتي 100% ينتهي أو يصل ال 100%عند انتهاء تنفيذ أمر الكود.... فاهمني حضرتك ؟؟
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 ولكن الكود لا يحتاج لشريط تقدم وشريط التقدم ليس عملي كما يظن الكثير .. وأعتقد هذا طلب مختلف لذا الأفضل طرح موضوع جديد اطلع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لتعرف كيفية التعامل بشكل أفضل مع المنتدى
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 (معدل) منذ ساعه, ياسر خليل أبو البراء said: ولكن الكود لا يحتاج لشريط تقدم وشريط التقدم ليس عملي كما يظن الكثير .. وأعتقد هذا طلب مختلف لذا الأفضل طرح موضوع جديد اطلع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لتعرف كيفية التعامل بشكل أفضل مع المنتدى في الواقع انا محتاج لشريط التقدم هنا في هذا الكود... ومحتاجه أيضا في كود آخر. كلا الكودين يأخذ حوالي دقيقه أو اكثر لإتمام التنفيذ. كود شريط التقدم موجود في عدة منتديات عربيه وأجنبية....لقد حصلت عليه ولكن لم أستطع تنفيذه مع اكوادي أو انا مش فاهم فكرته. عموما سأضع الكود الخاص بك في موضوع منفصل واطلب من الاخوه الأفاضل (طلب عمل دمج للكود مع كود شريط التقدم). عندي فكره ممتازه:- ايه رايك لو ارفق لك ملف شريط التقدم وحضرتك تحاول تدمجه مع الكود الخاص بك هنا؟؟؟ تم تعديل أغسطس 19, 2017 بواسطه kh34d
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 تفضل الملف التالي كنت عملته من فترة على الفيس ..فيه شريط التقدم بخطوات بسيطة وفيه مثالين واحد لو الكود فيه حلقات تكرارية والمثال التاني لو الكود مفيهوش حلقات تكرارية Create VBA Progress Bar UserForm With Step By Step Instructions YasserKhalil Facebook.rar
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 (معدل) 31 دقائق مضت, ياسر خليل أبو البراء said: تفضل الملف التالي كنت عملته من فترة على الفيس ..فيه شريط التقدم بخطوات بسيطة وفيه مثالين واحد لو الكود فيه حلقات تكرارية والمثال التاني لو الكود مفيهوش حلقات تكرارية Create VBA Progress Bar UserForm With Step By Step Instructions YasserKhalil Facebook.rar اه معايا نفس الملف... ومعي ملف آخر من منتدي اجنبي. ملف حضرتك انا مكنتش عارف ادمجه مع الكود الخاص بي.. وكلمت حضرتك على الفيس بوك... وقولت لحضرتك كدا وحضرتك قولتلي احط موضوعي في منتدى معين على ما اتذكر... هذا هو انت اليس كذلك ؟؟ ابعت لحضرتك صوره من المحادثه؟؟ هنا تم تعديل أغسطس 19, 2017 بواسطه kh34d
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 أنت مصر على عدم فتح موضوع جديد لكل طلب ولا أعلم السبب عموماً تفضل الملف به شريط التقدم عله يكون المطلوب فاتورة.rar
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 3 دقائق مضت, ياسر خليل أبو البراء said: أنت مصر على عدم فتح موضوع جديد لكل طلب ولا أعلم السبب عموماً تفضل الملف به شريط التقدم عله يكون المطلوب فاتورة.rar لا والله انا ممكن افتح كذا موضوع مستقل... لكن الفكره اني عايز حضرتك بالذات اللي تعمله.... ما شاء الله لا قوة إلا بالله فعملك بجد ممتاز... ربنا يذيك من علمه.. اللهم آمين
ياسر خليل أبو البراء قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 بارك الله فيك أخي الكريم ... اللي مش عارف اسمه بس كل الأعضاء هنا بيقدموا حلول ممتازة لو إنت متابع كويس المنتدى هتلاقي درر وكنوز وحاول تستخدم ميزة البحث في المنتدى ففي كثير من الأحيان ستجد الإجابة على تسؤالك في موضوعات البحث عموماً الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات .. يرجى اختيار أفضل إجابة ليظهر الموضوع مجاب ومنتهي ......... تقبل وافر تقديري واحترامي
kh34d قام بنشر أغسطس 19, 2017 الكاتب قام بنشر أغسطس 19, 2017 (معدل) 3 ساعات مضت, ياسر خليل أبو البراء said: بارك الله فيك أخي الكريم ... اللي مش عارف اسمه بس كل الأعضاء هنا بيقدموا حلول ممتازة لو إنت متابع كويس المنتدى هتلاقي درر وكنوز وحاول تستخدم ميزة البحث في المنتدى ففي كثير من الأحيان ستجد الإجابة على تسؤالك في موضوعات البحث عموماً الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات .. يرجى اختيار أفضل إجابة ليظهر الموضوع مجاب ومنتهي ......... تقبل وافر تقديري واحترامي ربنا يكرمك... انا اسمي خالد من مصر ارجو الانتظار لاني لم اختبر الملف بعد.. لانشغالي... عذرا لذلك. عندما اتأكد منه سأخبرك بإذن الله تم تعديل أغسطس 19, 2017 بواسطه kh34d
سليم حاصبيا قام بنشر أغسطس 19, 2017 قام بنشر أغسطس 19, 2017 بعد اذن اخي ياسر جرب هذا الملف هناك 2 كود الاول في حدث الصفحة invoice Option Explicit Private Sub Worksheet_Activate() Dim answer% answer = MsgBox("هل تريد زيادة ترقيم الفاتورة", vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading + vbQuestion, "ُExcel Ask You") If answer = 6 Then Me.Range("d5") = Me.Range("d5") + 1 Me.Rows.Hidden = False End If End Sub الثاني في Mudule عادي Salim Option Explicit Sub Copy_Data() Dim Sh_To_Copy As Worksheet, Sh_To_Paste As Worksheet Dim Rg_Copy As Range Dim lrCopy%, Lrpast%, m%, My_Num%, i% Dim My_Str As String, Answer2% Set Sh_To_Copy = Sheets("invoice"): Set Sh_To_Paste = Sheets("recycle") Sh_To_Paste.Unprotect 11 Sh_To_Copy.Range("a9:f25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True My_Str = Sh_To_Copy.Range("c5").Value My_Num = Sh_To_Copy.Range("d5").Value lrCopy = Sh_To_Copy.Cells(Rows.Count, 1).End(3).Row Lrpast = Sh_To_Paste.Cells(Rows.Count, 1).End(3).Row For i = 5 To Lrpast If Sh_To_Paste.Range("c" & i) = My_Str And Sh_To_Paste.Range("d" & i) = My_Num Then Answer2 = MsgBox("الفاتورة تحت هذا الرقم موجوده هل تريد استبدالها", vbYesNo) If Answer2 <> 6 Then Sh_To_Paste.Protect 11: Exit Sub Exit For End If Next Set Rg_Copy = Sh_To_Copy.Range("a5:F" & lrCopy).SpecialCells(12) m = Rg_Copy.Rows.Count Sh_To_Paste.Range("a5:a" & m + 8).EntireRow.Insert Rg_Copy.Copy Sh_To_Paste.Range("a5") Sh_To_Paste.Protect 11 End Sub Facture_salim.rar
kh34d قام بنشر أغسطس 20, 2017 الكاتب قام بنشر أغسطس 20, 2017 (معدل) 10 ساعات مضت, سليم حاصبيا said: بعد اذن اخي ياسر جرب هذا الملف هناك 2 كود الاول في حدث الصفحة invoice Option Explicit Private Sub Worksheet_Activate() Dim answer% answer = MsgBox("هل تريد زيادة ترقيم الفاتورة", vbYesNo + vbMsgBoxRight + vbMsgBoxRtlReading + vbQuestion, "ُExcel Ask You") If answer = 6 Then Me.Range("d5") = Me.Range("d5") + 1 Me.Rows.Hidden = False End If End Sub الثاني في Mudule عادي Salim Option Explicit Sub Copy_Data() Dim Sh_To_Copy As Worksheet, Sh_To_Paste As Worksheet Dim Rg_Copy As Range Dim lrCopy%, Lrpast%, m%, My_Num%, i% Dim My_Str As String, Answer2% Set Sh_To_Copy = Sheets("invoice"): Set Sh_To_Paste = Sheets("recycle") Sh_To_Paste.Unprotect 11 Sh_To_Copy.Range("a9:f25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True My_Str = Sh_To_Copy.Range("c5").Value My_Num = Sh_To_Copy.Range("d5").Value lrCopy = Sh_To_Copy.Cells(Rows.Count, 1).End(3).Row Lrpast = Sh_To_Paste.Cells(Rows.Count, 1).End(3).Row For i = 5 To Lrpast If Sh_To_Paste.Range("c" & i) = My_Str And Sh_To_Paste.Range("d" & i) = My_Num Then Answer2 = MsgBox("الفاتورة تحت هذا الرقم موجوده هل تريد استبدالها", vbYesNo) If Answer2 <> 6 Then Sh_To_Paste.Protect 11: Exit Sub Exit For End If Next Set Rg_Copy = Sh_To_Copy.Range("a5:F" & lrCopy).SpecialCells(12) m = Rg_Copy.Rows.Count Sh_To_Paste.Range("a5:a" & m + 8).EntireRow.Insert Rg_Copy.Copy Sh_To_Paste.Range("a5") Sh_To_Paste.Protect 11 End Sub Facture_salim.rar بارك الله فيك اخي... سلمت يمينك افكار جديده واكواد جديده... شكرا لك 15 ساعات مضت, ياسر خليل أبو البراء said: أنت مصر على عدم فتح موضوع جديد لكل طلب ولا أعلم السبب عموماً تفضل الملف به شريط التقدم عله يكون المطلوب فاتورة.rar الكود ما شاء الله شغال 100% تسلم الايادي فيه حاجه بسيطه: 1- لو مفيش بيانات في الفاتورة الاصليه عند الترحيل...بيظهر رسالة no data كدا تمام... لكن شريط التقدم بيظل ظاهر عند 0% ولا يختفي ...المفروض يختفي؟؟ وكذلك تظهر الاعمدة المختفيه لا اعرف لماذا؟؟ 2- ولو هذا الشريط ... فيه زرار ok ,cancle لالغاء عمل الكود...علشان لو لقيت الفاتورة فيها غلط الغي الامر ...يكون افضل 3- لو انا غلطت ومنزلتيش كمية الصنف الاول ونزلت كمية الصنف التاني مثلا...وعملت ترحيل؟! ...يتم الترحيل وهذا خطأ. المفروض ان شرط الترحيل ان يكون التاريخ وكميات الاصناف موجوده (كل خانات الكميات اقصد). *****ا نا عارف ان طلباتي كتير وتعبت حضرتك....ان كانت في الامكان ...فجزاك الله خير ورزقك من حيث لا تحتسب... وان لم تكن ...فجزاك الله كل خير ايضا وذادك من علمه ***** تم تعديل أغسطس 20, 2017 بواسطه kh34d
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.