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

طلب في تعديل الفاتورة


إذهب إلى أفضل إجابة Solved by احمدزمان,

الردود الموصى بها

 هاد المشاركة الاولى لي في منتدة الاكسل

 

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

في تقديم المساعدات الي الاخرين



اما المقصود في طلبي تعديل في اكواد ان يرحل كل من رقم الفاتورة / تاريخ الفاتورة / اسم المستفيد/ تاريخ الاستحقاق مع كل سطر " صف " من اسطر الفاتورة فى صفحة البيانات



ويبقى البنود التالية :

- عند الضغط على زر الترحيل يتم ترحيل البيانات مع مسحها من الفاتورة لتكون الفاتورة جاهزه لادخال بيانات جديدة

طلب اخر اخفاء الظهور ازرار في ورقة الطباعة
زير تعديل زير ترحيل زير حزف

ولكم جزيل الشكر

 

وارجو منكم تعاون في تطويرها عندي محل بيع المواد الغذائية ؤريد تسير بها الفاوتير

رابط هذا التعليق
شارك

 هاد المشاركة الاولى لي في منتدة الاكسل

 

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

في تقديم المساعدات الي الاخرين



اما المقصود في طلبي تعديل في اكواد ان يرحل كل من رقم الفاتورة / تاريخ الفاتورة / اسم المستفيد/ تاريخ الاستحقاق مع كل سطر " صف " من اسطر الفاتورة فى صفحة البيانات



ويبقى البنود التالية :

- عند الضغط على زر الترحيل يتم ترحيل البيانات مع مسحها من الفاتورة لتكون الفاتورة جاهزه لادخال بيانات جديدة

طلب اخر اخفاء الظهور ازرار في ورقة الطباعة
زير تعديل زير ترحيل زير حزف

ولكم جزيل الشكر

 

وارجو منكم تعاون في تطويرها عندي محل بيع المواد الغذائية ؤريد تسير بها الفاوتير

نموزج فاتورة 1.rar

رابط هذا التعليق
شارك

 هاد المشاركة الاولى لي في منتدة الاكسل

 

سلام عليكم ورحمة الله وبركاتة

شكرا جزيلا للجميع

في تقديم المساعدات الي الاخرين

اما المقصود في طلبي تعديل في اكواد ان يرحل كل من رقم الفاتورة / تاريخ الفاتورة / اسم المستفيد/ تاريخ الاستحقاق مع كل سطر " صف " من اسطر الفاتورة فى صفحة البيانات

ويبقى البنود التالية :

- عند الضغط على زر الترحيل يتم ترحيل البيانات مع مسحها من الفاتورة لتكون الفاتورة جاهزه لادخال بيانات جديدة

طلب اخر اخفاء الظهور ازرار في ورقة الطباعة

زير تعديل زير ترحيل زير حزف

ولكم جزيل الشكر

 

وارجو منكم تعاون في تطويرها عندي محل بيع المواد الغذائية ؤريد تسير بها الفاوتير

نموزج فاتورة 1.rar

تم تعديل بواسطه ابا اسماعيل
رابط هذا التعليق
شارك

وعليكم السلام و رحمة الله وبركاته

 

 

 

اما المقصود في طلبي تعديل في اكواد ان يرحل كل من رقم الفاتورة / تاريخ الفاتورة / اسم المستفيد/ تاريخ الاستحقاق مع كل سطر " صف " من اسطر الفاتورة فى صفحة البيانات

 

يتم الترحيل الى اي صفحة

  • Like 1
رابط هذا التعليق
شارك

وعليكم السلام و رحمة الله وبركاته  الاخ الكريم

احمدزمان  المقصود في طلبي هواترحل كل من رقم الفاتورة / تاريخ الفاتورة / اسم المستفيد/ تاريخ الاستحقاق  من الفاتورة من صفحة البيانات invoice الى صفحة mat
رابط هذا التعليق
شارك

السلام عليكم و رحمة الله وبركاته

 

اخي الفاضل

 

استفدنا من الكود  الموجود

وقمنا بعمل كود يقوم بـ4خطوات بضغطة واحدة

 

ترحيل الفاتورة

طباعة الفاتورة بعد الترحيل

مسح الفاتورة

زيادة رقم 1 لرقم الفاتورة بعد المسح

Sub trhil_invoice()
Application.ScreenUpdating = False
Dim LR As Long, LR1 As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("INVOICE")
Set WS1 = Worksheets("mat")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
Dim FR
    
    For r = 6 To LR1
        If WS1.Cells(r, 3) = WS.Range("I3") Then MsgBox "This invoice already exist, No shift will done": Exit Sub
    Next
For FR = 10 To 50
If WS.Cells(FR, 3) = "" Then GoTo 7

WS1.Cells(LR1, 2) = WS.Range("E3").Value
WS1.Cells(LR1, 3) = WS.Range("I3").Value
WS1.Cells(LR1, 4) = WS.Range("E5").Value
WS1.Cells(LR1, 12) = WS.Range("E7").Value

WS.Range("D" & FR & ":J" & FR).Copy
WS1.Range("E" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
LR1 = LR1 + 1
7 Next FR

Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
2 Range("A1:K53").PrintOut Copies:=1
Q1 = MsgBox("Êã ÍÝÙ ÈíÇäÇÊ ÇáÝÇÊæÑÉ æ ÌÇÑí ØÈÇÚÉ ÇáÝÇÊæÑÉ - åá ÊÑíÏ ØÈÇÚÉ äÓÎ ÇÎÑì", vbYesNo, "ØÈÇÚÉ")
If Q1 = vbYes Then GoTo 2

Range("E3,E5,E7,D10:H49,J10:J49").ClearContents
Range("E3").Select
ActiveWindow.SmallScroll Down:=-45
Range("I3") = Range("I3") + 1
End Sub

آمل ان يكون به المطلوب

 

 

نموزج فاتورة.rar

  • Like 2
رابط هذا التعليق
شارك

السلام عليكم و رحمة الله وبركاته

 

اخي الفاضل

 

استفدنا من الكود  الموجود

وقمنا بعمل كود يقوم بـ4خطوات بضغطة واحدة

 

ترحيل الفاتورة

طباعة الفاتورة بعد الترحيل

مسح الفاتورة

زيادة رقم 1 لرقم الفاتورة بعد المسح

Sub trhil_invoice()
Application.ScreenUpdating = False
Dim LR As Long, LR1 As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("INVOICE")
Set WS1 = Worksheets("mat")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
Dim FR
    
    For r = 6 To LR1
        If WS1.Cells(r, 3) = WS.Range("I3") Then MsgBox "This invoice already exist, No shift will done": Exit Sub
    Next
For FR = 10 To 50
If WS.Cells(FR, 3) = "" Then GoTo 7

WS1.Cells(LR1, 2) = WS.Range("E3").Value
WS1.Cells(LR1, 3) = WS.Range("I3").Value
WS1.Cells(LR1, 4) = WS.Range("E5").Value
WS1.Cells(LR1, 12) = WS.Range("E7").Value

WS.Range("D" & FR & ":J" & FR).Copy
WS1.Range("E" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
LR1 = LR1 + 1
7 Next FR

Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
2 Range("A1:K53").PrintOut Copies:=1
Q1 = MsgBox("Êã ÍÝÙ ÈíÇäÇÊ ÇáÝÇÊæÑÉ æ ÌÇÑí ØÈÇÚÉ ÇáÝÇÊæÑÉ - åá ÊÑíÏ ØÈÇÚÉ äÓÎ ÇÎÑì", vbYesNo, "ØÈÇÚÉ")
If Q1 = vbYes Then GoTo 2

Range("E3,E5,E7,D10:H49,J10:J49").ClearContents
Range("E3").Select
ActiveWindow.SmallScroll Down:=-45
Range("I3") = Range("I3") + 1
End Sub

آمل ان يكون به المطلوب

 

 

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

 

اخي الفاضل براك الله فيك  على العمل وتعديل الكود الدى هوا

وقمتا بعمل كود يقوم بـ4خطوات بضغطة واحدة

 

ترحيل الفاتورة

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

و أسف على  المطلب الكترا

تم تعديل بواسطه ابا اسماعيل
رابط هذا التعليق
شارك

طلب تعديل الكود   استدعاء استدعاء رقم فاتورة بيع بجميع تفاصيلها

 

اما الكود ترحيل وطباعة تامة تعدلوا هوما بي وستات  الااخ

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

رابط هذا التعليق
شارك

  • 2 weeks later...

السلام عليكم و رحمة الله وبركاته

 

نحن ممكن نعمل استدعاء

ولكن

 المشكلة انه يجب ان يكون هذا الإستدعاء بدون تعديل في بيانات الفاتورة

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

رابط هذا التعليق
شارك

اخى الفاضل

 

راجع هذا الموضوع للأستاذ الفاضل / حمادة عمر جزاه الله خيراً، سيفيدك كثيرا في طلبك

 

طريقة عمل فورم فاتورة ووضع اكوادها وترحيلها واستدعائها وطباعتها !! خطوة خطوة

 

والمنتدي به أكثر من مئات المواضيع عن الفواتير وكيفية ترحيلها واستدعائها .. جرب في البحث في الأعلى على اليسار واكتب "فاتورة" ستجد مئات المواضيع التى ستفيدك بكل تأكيد

 

خالص تحياتي

تم تعديل بواسطه ibn_egypt
رابط هذا التعليق
شارك

السلام عليكم ورحمة الله وبركاته

 

اضفنا زر لمسح بيانات الفاتورة الحالية

Sub invoice_cleer()
'مسح كامل بيانات الفاتورة و اضافة  رقم فاتورة
Sheets("invoice").Select
Sheets("invoice").Unprotect
Range("E3,J3,E5,E7,D10:H49,J10:J49,L10:L49").ClearContents
    Range("E3").FormulaR1C1 = "=NOW()"
    Range("F3").FormulaR1C1 = "=R3C5"
    ActiveSheet.PageSetup.PrintArea = "$B$2:$K$53"
    ActiveWindow.View = xlPageBreakPreview
    ActiveWindow.Zoom = 113
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.LargeScroll Down:=-99
    ActiveWindow.LargeScroll ToRight:=99
    Range("I3") = Range("L3")
    Range("E5").Select

End Sub

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

 

ثم

 

اضفنا زر جلب البيانات لأي فاتورة

بالضغط علية يظهر مربع نص تدخل به رقم الفاتورة المطلوبة ثم موافق

يتم اظهار بيانات الفاتورة المطلوبة

مع 

كتابة COPY بجوار رقم الفاتورة

Sub GET_INV_NO()
'جلب بيانات الفاتوورة بالرقم
Q1 = InputBox("INPUT BOLL No أدخل رقمالفاتورة المطلوبة", "جلب")
Q1 = Val(Q1)
Set WS = Worksheets("INVOICE")
Set WS1 = Worksheets("mat")
WS.Select
WS.Range("E3,E5,E7,D10:H49,J10:J49,L10:L49").ClearContents
WS.Range("J3").Text = "نسخة Copy"
WS.Unprotect

LR1 = WS1.Range("c55555").End(xlUp).Row + 1
TR = 10
For FR = 4 To LR1
If WS1.Cells(FR, 3) = Q1 Then
WS.Range("E3") = WS1.Cells(FR, 2).Value
WS.Range("I3") = WS1.Cells(FR, 3).Value
WS.Range("E5") = WS1.Cells(FR, 4).Value
WS.Range("E7") = WS1.Cells(FR, 12).Value
WS1.Range("E" & FR & ":K" & FR).Copy
WS.Range("D" & TR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("L" & TR) = FR
TR = TR + 1
End If
Next FR

End Sub

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم و رحمة الله و بركاته

 

اضفنا زر لتعديل بيانات الفاتورة

 

بعد جلب بيات الفاتورة 

قم بتعديل ماتريد

و

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

ثم اضغط علة تعديل

يتم تعديل البيانات

مع الخزاص السابقة لأضافة فاتورة

من

ترحيل ثم طباعة ثم مسح بيانات الفاتورة

Sub trhill_Tadeel()
'ÊÑÍíá ÇáÝæÇÊíÑ ÇáãÚÏáå
Application.ScreenUpdating = False
Set WS = Worksheets("INVOICE")
Set WS1 = Worksheets("mat")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
If WS.Range("J3") = "" Then GoTo 6
    
For FR = 10 To 50
LR1 = Val(WS.Cells(FR, 12))
If WS.Cells(FR, 12) = "" Then GoTo 7
WS1.Cells(LR1, 2) = WS.Range("E3").Value
WS1.Cells(LR1, 3) = WS.Range("I3").Value
WS1.Cells(LR1, 4) = WS.Range("E5").Value
WS1.Cells(LR1, 12) = WS.Range("E7").Value

WS.Range("D" & FR & ":J" & FR).Copy
WS1.Range("E" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
LR1 = LR1 + 1
7 Next FR

Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
2 Range("A1:K53").PrintOut Copies:=1
Q1 = MsgBox("Êã ÍÝÙ ÈíÇäÇÊ ÇáÝÇÊæÑÉ æ ÌÇÑí ØÈÇÚÉ ÇáÝÇÊæÑÉ - åá ÊÑíÏ ØÈÇÚÉ äÓÎ ÇÎÑì", vbYesNo, "ØÈÇÚÉ")
If Q1 = vbYes Then GoTo 2
6
Application.Run "invoice_cleer"

Range("E3").Select
End Sub

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم و رحمة الله

 

وصلنا للخطوة الأخيرة

مسح الفاتورة

لحذف الفاتورة يجب جلب بياناتها اولا

اضغط جلب فاتورة وادخل الرقم 

بعد جلب الفاتورة اضغط حذف

يتم حذف بيانات الفاتورة

Sub invoice_Kill()
' ÍÐÝ ÈíÇäÇÊ ÝÇÊæÑÉ
Application.ScreenUpdating = False
Set WS = Worksheets("INVOICE")
Set WS1 = Worksheets("mat")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
If WS.Range("J3") = "" Then GoTo 6
For FR = 10 To 50
LR1 = Val(WS.Cells(FR, 12))
If WS.Cells(FR, 12) = "" Then GoTo 7

WS1.Range("D" & LR1 & ":L" & LR1).ClearContents
LR1 = LR1 + 1
7 Next FR

Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
6 MsgBox "Êã ÍÐÝ ÈíÇäÇÊ ÇáÝÇÊæÑÉ THIS BILL DELETED"
Application.Run "invoice_cleer"

Range("E3").Select
End Sub

 

 

اضفنا بعض التنسيقات للورقة

و

اصبح جاهز للإستخدام

 

نموزج فاتورة.rar

  • Like 1
رابط هذا التعليق
شارك

لسلام عليكم و رحمة الله و بركاته

احمدزمان

 

براك الله فيك  لتعديل بيانات الفاتورة وارجو ان لااكون قد اتقلتو عليك ولكن مشكلة في الاكود هدا

 

 

WS.Range("J3").Text = "äÓÎÉ Copy"
 

 

 

http://www.gulfup.com/?gbfCI2

رابط هذا التعليق
شارك

السلام عليكم

هذا نموذج من اعداد الأستاذ الفاضل عبدالله باقشير

 

بعد دبل كليك من النموذج اكتب اي حرف من اسم الصنف 

يظهر لك الكود و الإسم والنوع

حدد ما تريد ثم اضغط اضافة

 

آمل ان يكون هذا ما تريد

 

نموزج فاتورة+بحث.rar

رابط هذا التعليق
شارك

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

رابط هذا التعليق
شارك

وعليكم السلام و رحمة الله وبركاته

 

ان شاء الله سوف احاول تنفيذ طلبك

 

=======================

 

وتبقى الخطوة التالية

البحث و استخراج النتائج من ورقة المبيعات حسب التاريخ لفترة محددة و حسب اسم العميل

رابط هذا التعليق
شارك

السلام عليكم و رحمة الله وبركاته

 

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

 

ارجوالمساعدة في كود  حفظ دالة sum في الفاتورة اي ضرب الكمية و السعر

المشكل  هو عندما يتم حفظ الفاتورة في الفولدر يتم حدف الدالة  sum من خانة ; و علي داىما ادخالها من جديد جزاك الله خيرا استاذى الفاضل

نموزج فاتورة+بحث.rar

رابط هذا التعليق
شارك

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 اعضاء متواجدين الان

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

Important Information