نجوم المشاركات

اضم صوتي لصوت اخي حربي العنزي محتاج ايضا لعمل هذه الاداه لجلب اوزان من ميزان الكتروني

يمكنك الإستعانة بهذه الفيديوهات https://www.youtube.com/watch?v=w_lH3sZyUDY https://www.youtube.com/watch?v=x-w_Z6UHCnQ https://www.youtube.com/watch?v=pGVzzvrR2L4 https://www.youtube.com/watch?v=ErocP5o0ARM وهذان ملفان وورد واكسيل تم نقل بيانات شيت الإكسيل الى الوورد كما ترى excel to word.xlsm ser.docx

ولكى يعمل هذا الكود معك فى كل صفحة جديدة تفتحها داخل الملف لابد من وضع هذا الكود فى حدث This WorkBook Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call Test End Sub كود ضرب.xlsm

تفضل 2أوفيسنا.xlsx

طبعا يمكن العمل فى كل صفحة ولكن لابد من ربطه بزر Sub Test() 'بداية الكود Dim LR As Long 'تحديد LR كمتغير الى اخر سطر به بيانات LR = Range("C" & Rows.Count).End(xlUp).Row Range("E1:E" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR) 'حاصل ضرب العمود C مع العمود D 'واخراج الناتج فى العمود E End Sub 'نهاية الكود

وعليكم السلام بالملف موجود كود لحاصل ضرب العمودان C & D واخراج الناتج فى العمود E Sub Test() Dim LR As Long LR = Range("C" & Rows.Count).End(xlUp).Row Range("E1:E" & LR) = Evaluate("C1:C" & LR & "*D1:D" & LR) End Sub كود ضرب.xlsm

أخي الكريم @kanoryمشكور و جزاك الله كل خير

السلام عليكم الى الاخوة من وجد في هدا البرنامج مشكلة قم بتحميل النسخة المعدلة ثم الغاء كود تاكد من وجود ملف وتغيير رقم واسم المستخدم المستخدم: 1 رقم السري : 1 تعديل برنامج المطعم.rar

تفضل Tab_Ali.xlsx

نعم تفضل .... طلب_صرف_مواد2.accdb

من تصميم التقرير اعمل في حقل التاريخ فرز تصاعدي انا بالمبيال ولم استطيع اشوف المرفق

فك الضغط بواسطة 7zip

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

Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim My_String As String My_String = "" If Not Intersect(Target, Range("A:A")) Is Nothing Then m = Target.Count c = [AA1] k = tt If IsEmpty(k) Then GoTo 1 If m * c >= 1 Then Application.EnableEvents = False my_pass = Application.InputBox(" لا يمكن التعديل في هذه الخلايا.... الا بحالات خاصة تتطلب كلمة مرور", "password") If my_pass <> "pass" Then If Not (IsArray(k)) Then My_String = k Else For x = LBound(k, 1) To UBound(k, 1) My_String = My_String & k(x, 1) & "," Next My_String = Left(My_String, Len(My_String) - 1) End If MsgBox "اسف كلمة المرور غير صحيحة" & Chr(10) & " سيتم اعادة الخلايا الى قيمتها الاصلية: " & Chr(10) & My_String, _ vbMsgBoxRtlReading + vbInformation + vbMsgBoxRight, "ســليم حاصــبيّا يبلغك :" Application.Undo GoTo 1 End If End If End If 1: Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) tt = Selection.Value End Sub هدا هو الكود

جزاك الله خيرا ابا مذحج ،،،