اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search
kh34d

ترحيل فاتورة من صفحه الي اخري في نفس الملف

Recommended Posts

السلام عليكم اخواني الكرام

بعد اذنكم انا عايز ارحل الفاتورة المرفقه من الصفحه الاساسيه ( 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

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

السلام عليكم

جرب الكود التالي عله يفي بالغرض ..

في ورقة العمل المسماة recycle اجعل عنوان أول فاتورة موجودة في الصف رقم 3 

Untitled.png.40fd78a57a708fed6519ba6f9a816ee3.png

 

عند التعامل مع ورقة العمل 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

 

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

تقبل تحياتي

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك
48 دقائق مضت, ياسر خليل أبو البراء said:

السلام عليكم

جرب الكود التالي عله يفي بالغرض ..

في ورقة العمل المسماة recycle اجعل عنوان أول فاتورة موجودة في الصف رقم 3 

Untitled.png.40fd78a57a708fed6519ba6f9a816ee3.png

 

عند التعامل مع ورقة العمل 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 كما هي بالتسلسل الطبيعي لها في عملي...لاني بعمل بحث بعد كدا علي ارقام الفواتير

*** ارجوا ان لا اكون اثقلت عليك وشكرا جدا جدا علي تعبك معايا

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

من الأفضل تناول نقطة نقطة لأني لا أملك الوقت الآن للعمل على كل النقاط مرة واحدة .. والأفضل إرفاق ملف معبر عن المطلوب كما أخبرتك من قبل 

الآن تغيرت هيكلة الملف ويوجد تفاصيل جديدة غير موجودة في الملف الأول 

سأجيبك على نقطة واحدة فقط ألا وهي الصفوف المخفية .. 

قم باستبدال كلمة rg في السطر التالي

rg.EntireRow.Hidden = False

بهذه الكلمة

ws.Range("A5:F26")

 

كما يفضل أن يكون لكل طلب موضوع مستقل لتجد استجابة أفضل من الأعضاء بالمنتدى

تقبل تحياتي

  • Like 2

شارك هذه المشاركه


رابط المشاركه
شارك
20 دقائق مضت, ياسر خليل أبو البراء said:

من الأفضل تناول نقطة نقطة لأني لا أملك الوقت الآن للعمل على كل النقاط مرة واحدة .. والأفضل إرفاق ملف معبر عن المطلوب كما أخبرتك من قبل 

الآن تغيرت هيكلة الملف ويوجد تفاصيل جديدة غير موجودة في الملف الأول 

سأجيبك على نقطة واحدة فقط ألا وهي الصفوف المخفية .. 

قم باستبدال كلمة rg في السطر التالي


rg.EntireRow.Hidden = False

بهذه الكلمة


ws.Range("A5:F26")

 

كما يفضل أن يكون لكل طلب موضوع مستقل لتجد استجابة أفضل من الأعضاء بالمنتدى

تقبل تحياتي

بارك الله فيك

ولكن ان ما ذكرته  لك من تعديل هو كان مطلوب منذ الوهله الاولي....؟؟

الا موضوع الاعمده المخفيه  وهو تكمله كانت موجوده عندي ...ولم اذكرها علي انها غير مهمه....اعتقد انها تتطلب تغير المدي واظهارها بشكل ما

 

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

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

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

حتى يشارك الجميع ...

 

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

آخر نقطة تحدثنا بها وهي إظهار الصفوف المخفية بعد الترحيل وقد وجهتك لتغيير النطاق من rg إلى A2:F26 >> فهل قمت بحل هذه النقطة أم لا؟

شارك هذه المشاركه


رابط المشاركه
شارك
12 دقائق مضت, ياسر خليل أبو البراء said:

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

حتى يشارك الجميع ...

 

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

آخر نقطة تحدثنا بها وهي إظهار الصفوف المخفية بعد الترحيل وقد وجهتك لتغيير النطاق من rg إلى A2:F26 >> فهل قمت بحل هذه النقطة أم لا؟

نعم تم حل المشكله...شكرا لك

النقطه التاليه هي:-

3- المدي المراد نسخه هو (a5:m27) ككل من الصفحه الاساسيه invoice

مع العلم بان جزء من ذلك  المدي ( h5:m27  )مخفي

وبه بيانات واريد اظهارها هذه المره >>بعد الترحيل في الصفحه الثانيه recycle

بعكس ما سبق بخصوص الصفوف المخفيه

 

بمعني اخر :-

ترحيل الظاهر  فقط  من الصفوف في المدي a5:f27

مع ترحيل المخفي من الصفوف في المدي h5:m27

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

تفضل المرفق التالي .. وإذا لم يكن المطلوب وضح اكثر بملف مرفق من عندك إذ أني أخبرتك أني لا أعمل على التخمين

وفيه نقطة مهمة لابد من العلم بها أنه طالما الصفوف مخفية في النطاق A2:F27 فلا يمكن أن تظهر نفس الصفوف في النطاق H2:M27 وإنما ما يمكن إظهاره وإخفاؤه هو الأعمدة نفسها من H إلى M

عموماً المرفق عدلت فيه قليلاً حيث قمت في ورقة الـ recycle بحذف صفوف فارغة بحيث تبدأ البيانات من أول الصف الثالث (لأنك سألت عن تلك النقطة من قبل)

وقمت بفك الحماية عن عمود الكميات وخلية التاريخ بحيث تتمكن من الإدخال والورقة محمية

فاتورة.rar

  • Like 1

شارك هذه المشاركه


رابط المشاركه
شارك
20 دقائق مضت, ياسر خليل أبو البراء said:

تفضل المرفق التالي .. وإذا لم يكن المطلوب وضح اكثر بملف مرفق من عندك إذ أني أخبرتك أني لا أعمل على التخمين

وفيه نقطة مهمة لابد من العلم بها أنه طالما الصفوف مخفية في النطاق A2:F27 فلا يمكن أن تظهر نفس الصفوف في النطاق H2:M27 وإنما ما يمكن إظهاره وإخفاؤه هو الأعمدة نفسها من H إلى M

عموماً المرفق عدلت فيه قليلاً حيث قمت في ورقة الـ recycle بحذف صفوف فارغة بحيث تبدأ البيانات من أول الصف الثالث (لأنك سألت عن تلك النقطة من قبل)

وقمت بفك الحماية عن عمود الكميات وخلية التاريخ بحيث تتمكن من الإدخال والورقة محمية

فاتورة.rar

وربنا يكرمك يا رب

انا الان في طريقي للبيت بإذن الله... وعندما اصل سوف اطبق الملف الجديد بتاع حضرتك. 

النقطه التاليه:-

عمل شريط التقدم... بحيث عند تنفيذ هذا الكود لا  تظهر شكل الساعه الرملية العاديه لتنفيذ الأمر.... ولكن يظهر progress bar من 1%حتي 100% ينتهي أو يصل ال 100%عند انتهاء تنفيذ أمر الكود.... فاهمني حضرتك ؟؟

شارك هذه المشاركه


رابط المشاركه
شارك

ولكن الكود لا يحتاج لشريط تقدم وشريط التقدم ليس عملي كما يظن الكثير ..

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

اطلع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لتعرف كيفية التعامل بشكل أفضل مع المنتدى

 

شارك هذه المشاركه


رابط المشاركه
شارك
منذ ساعه, ياسر خليل أبو البراء said:

ولكن الكود لا يحتاج لشريط تقدم وشريط التقدم ليس عملي كما يظن الكثير ..

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

اطلع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى لتعرف كيفية التعامل بشكل أفضل مع المنتدى

 

في الواقع انا محتاج لشريط التقدم هنا في هذا الكود... ومحتاجه أيضا في كود آخر. 

كلا الكودين يأخذ  حوالي دقيقه أو اكثر  لإتمام التنفيذ. 

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

أو انا مش فاهم فكرته. 

عموما  سأضع الكود الخاص بك في  موضوع منفصل واطلب من الاخوه الأفاضل (طلب عمل دمج للكود  مع كود شريط التقدم).

عندي فكره ممتازه:-

ايه رايك لو ارفق لك ملف شريط التقدم وحضرتك تحاول تدمجه مع الكود الخاص بك هنا؟؟؟ 

 

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

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

Create VBA Progress Bar UserForm With Step By Step Instructions YasserKhalil Facebook.rar

شارك هذه المشاركه


رابط المشاركه
شارك
31 دقائق مضت, ياسر خليل أبو البراء said:

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

Create VBA Progress Bar UserForm With Step By Step Instructions YasserKhalil Facebook.rar

اه معايا نفس الملف... ومعي ملف آخر من منتدي  اجنبي. 

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

ابعت لحضرتك صوره من المحادثه؟؟ هنا  

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

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

عموماً تفضل الملف به شريط التقدم عله يكون المطلوب

فاتورة.rar

شارك هذه المشاركه


رابط المشاركه
شارك
3 دقائق مضت, ياسر خليل أبو البراء said:

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

عموماً تفضل الملف به شريط التقدم عله يكون المطلوب

فاتورة.rar

لا والله انا ممكن افتح كذا موضوع مستقل... لكن الفكره اني عايز حضرتك بالذات اللي تعمله.... ما شاء الله لا قوة إلا بالله فعملك  بجد ممتاز... ربنا يذيك  من علمه.. اللهم آمين 

شارك هذه المشاركه


رابط المشاركه
شارك

بارك الله فيك أخي الكريم ... اللي مش عارف اسمه

بس كل الأعضاء هنا بيقدموا حلول ممتازة لو إنت متابع كويس المنتدى هتلاقي درر وكنوز

وحاول تستخدم ميزة البحث في المنتدى ففي كثير من الأحيان ستجد الإجابة على تسؤالك في موضوعات البحث

عموماً الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات .. 

يرجى اختيار أفضل إجابة ليظهر الموضوع مجاب ومنتهي .........

تقبل وافر تقديري واحترامي

شارك هذه المشاركه


رابط المشاركه
شارك
3 ساعات مضت, ياسر خليل أبو البراء said:

بارك الله فيك أخي الكريم ... اللي مش عارف اسمه

بس كل الأعضاء هنا بيقدموا حلول ممتازة لو إنت متابع كويس المنتدى هتلاقي درر وكنوز

وحاول تستخدم ميزة البحث في المنتدى ففي كثير من الأحيان ستجد الإجابة على تسؤالك في موضوعات البحث

عموماً الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات .. 

يرجى اختيار أفضل إجابة ليظهر الموضوع مجاب ومنتهي .........

تقبل وافر تقديري واحترامي

ربنا يكرمك... انا اسمي خالد من مصر

ارجو الانتظار لاني لم اختبر الملف بعد..  لانشغالي... عذرا لذلك. 

عندما اتأكد منه سأخبرك بإذن  الله

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

بعد اذن اخي ياسر جرب هذا الملف

هناك 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

شارك هذه المشاركه


رابط المشاركه
شارك
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% تسلم الايادي

  :fff::signthankspin::fff::signthankspin:

 

فيه حاجه بسيطه:

1-  لو مفيش بيانات في الفاتورة الاصليه عند الترحيل...بيظهر رسالة no data كدا تمام... لكن شريط التقدم  بيظل ظاهر عند 0% ولا يختفي ...المفروض يختفي؟؟:wink2:

     وكذلك تظهر الاعمدة المختفيه لا اعرف لماذا؟؟

 

2- ولو هذا الشريط ... فيه زرار ok ,cancle   لالغاء عمل الكود...علشان لو لقيت الفاتورة فيها غلط  الغي الامر ...يكون افضل:dance1::dance1:

 

3- لو انا غلطت ومنزلتيش كمية الصنف الاول ونزلت كمية الصنف التاني مثلا...وعملت ترحيل؟! ...يتم الترحيل وهذا خطأ.

    المفروض ان شرط الترحيل ان يكون التاريخ وكميات الاصناف موجوده (كل خانات الكميات اقصد).

 

*****ا نا عارف ان طلباتي كتير وتعبت حضرتك....ان كانت في الامكان ...فجزاك الله خير ورزقك من حيث لا تحتسب...

وان لم تكن ...فجزاك الله كل خير ايضا وذادك من علمه  *****:clapping::clapping:

تم تعديل بواسطه kh34d

شارك هذه المشاركه


رابط المشاركه
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


  • المتواجدين الان   0 اعضاء متواجدين الان

    لايوجد اعضاء مسجلون يتصفحون هذه الصفحه

×
×
  • اضف...