عبدالواحد احمد

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

أخى الحبيب الغالى ياسر العربي  انا لم اقصد تجاهل معظم ردود لكن كانت عندي مشكلة في صندوق ردود ولم انتبه اعلاان

فعلن آسف .. جد آسف أستاذي القدير ياسر العربي

فائق إحتراماتي

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

أخى الحبيب الغالى / عبد العزيز السكرى

أخي الكريم ..  للأستاذ القدير ياسر العربي

بارك الله فيكم ونفع بكم الاسلام والمسلمين

حدف فاتورة باسورد.zip

اخي عبد العزيز البسكري  كان بي ودي رفع املف لكن الملف كبر

سوف اجيد طريقة لرفع الملف ان ساء الله

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

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

الفا تورة

جزاكم الله خيرًا و زادها بميزان حسناتكم

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

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

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

االود الاول

Sub invoice_cleer()
'مسح كامل بيانات الفاتورة و اضافة  رقم فاتورة
Sheets("invoice").Select
Sheets("invoice").Unprotect
Range("E3,I3,E5").ClearContents
Range("D10:J60").ClearContents

Range("E3").FormulaR1C1 = "=NOW()"
Range("F3").FormulaR1C1 = "=R3C5"
'Range("I10:I59").FormulaR1C1 = "=SUM(RC8*RC7)"
'Range("I10:I60").FormulaR1C1 = "=SUM(RC8*RC7)"
ActiveSheet.PageSetup.PrintArea = "$B$2:$K$65"
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.Zoom = 60
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.LargeScroll Down:=-99
ActiveWindow.LargeScroll ToRight:=99
Range("I3") = Range("L3")
Range("E5").Select
    
    
End Sub

كود التاني

Sub invoice_Kill()
' حذف بيانات فاتورة
Application.ScreenUpdating = False
Set Ws = Worksheets("INVOICE")
Set WS1 = Worksheets("Customers")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
If Ws.Range("J3") = "" Then GoTo 6
For FR = 10 To 60
LR1 = Val(Ws.Cells(FR, 12))
If Ws.Cells(FR, 12) = "" Then GoTo 7

WS1.Range("E" & LR1 & ":M" & 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"

On Error Resume Next
    Range("I60:I64").SpecialCells(xlCellTypeConstants).ClearContents
On Error GoTo 0
End Sub

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

جزاك الله خيرًا أستاذنا الفاضل ياسر خليل أبو البراء المحترم:

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

جزاك الله خيرًا أستاذنا الفاضل Adel.Hanafy

لما تم كتابة هذا Dim mm كامة شرتي

لقد تحول الخطأ الا هد السطر

ملف في المرقق اخي ياسر

اكود لجعل الفورم شفاف.zip

اكود لجعل الفورم شفاف.zip

ارجو المساعدة عندا اضافة الكود في الملف  توجهني هده المشكلة ولاعريف لها خل

هدا هو الملف اخي ياسر

اكود لجعل الفورم شفاف.

zip

أخى الفاضل

السلام عليكم 

اخي ياسر

بارك الله فيك على مجهودك

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

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

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

اكود لجعل الفورم شفاف.zip

ارجو الطلاع لماذا لا يعمل عندى هذا الكود في الملف

اكود لجعل الفورم شفاف.zip

ارجو اطلاع على الموضوع

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

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

اكود لجعل الفورم شفاف.zip

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

بارك الله فيك اخي الكريم أبو الحسن والحسين ونفعنا بما علمك الله وبارك لك في علمك وزادك فضلا وعلما اللهم امين

ارجو المساعدة  لدي مشكلة لما اضعط على زر المسح  تضهرلي هاده الاصفار التي تملؤبها الصفحة

تعديل في كود الفاتورة KHMB.zip

تعديل في كود الفاتورة KHMB.zip

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

بارك الله فيك اخي أبو الحسن والحسين ونفع بك الاسلام والمسلمين ربي يحفظه ويوفقه لما يُحبه ويرضاه

ممكن لوسمحت ان يتم اضافت في الكود الإجمالي والمدفوع والمتبقي

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

  تعديل هدا الكود انه لي واستاذنا / إبراهيم أبو ليله يحفظك الله

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

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

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [f16:f37]) Is Nothing Then
If Target.Value <> "" Then
Target.Offset(0, 2) = Target.Offset(0, 0) * Target.Offset(0, 1)

Range("i39") = Application.Sum(Range("h16:h37"))

Exit Sub
End If
If Target.Value = "" Then
Target.Offset(0, 2) = Target.Offset(0, 0) * Target.Offset(0, 1)

Range("i39") = Application.Sum(Range("h16:h37"))

Exit Sub
End If
End If
If Not Intersect(Target, [g16:g37]) Is Nothing Then
If Target.Value <> "" Then
Target.Offset(0, 1) = Target.Offset(0, 0) * Target.Offset(0, -1)

Range("i39") = Application.Sum(Range("h16:h37"))

Exit Sub
End If
If Target.Value = "" Then
Target.Offset(0, 1) = Target.Offset(0, 0) * Target.Offset(0, -1)

Range("i39") = Application.Sum(Range("h16:h37"))

Exit Sub
End If
End If
'.........................................................................

End Sub

hps.zip

لو سمحت اخي أبا الحسن والحسين اريد منك اضافة الكود الأخ إبراهيم ابوليله نه كود رائع بارك الله فيك يا أخي الفاضل و أعانك الله في فعل الخير

مشكور اخي KHMB بارك الله فيك على المساعدة ارجو ضبط الكود ليعمل في النطاق كمل

اخي إبراهيم ابوليله ارجو المساعدة في طلبي

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

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

لقدحاولت اعدل عليه في الملف لدي ولم يعمل معي

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

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

العطارتمسنا_2015_07_21.zip