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

سلام عليكم مرفق لك الملف اخوي spyhearts لكن تحتاج لتنسيق الاكواد الخاصة بك تم ترتيب الجدولة للملف تم ترتيب كود الاضافة وكود الحفظ وكود التعديل وكود الحذف وكود البحث تحتاج الحين لمساتك الشخصية لملفك لانه تم التعديل بالكامل userform-.xlsm

السلام عليكم أخي @حمدى الظابط 🙂 بحمد الله ضبطت لك كود إرسال البريد الإلكتروني .. ولكن هناك نقطة مهمة ( ضرووووووووووووووووووووري جدا جدا جدا ) إتباع الخطوات المذكورة في الموضوع التالي كتضبيطات للجيميل لكي يتم الاتصال بالبريد وإرسال الرسائل : ويفضل أن يتم حفظ بيانات البريد الإلكتروني والباسوورد (بشكل مشفر طبعا ) لأنه لايطلب باسوورد الدخول هنا بل الرقم البديل للباسوورد الذي يوفره لك الجيميل .. ويعطيك إياه لمرة واحدة .. وقمت بتعديل على مصدر بيانات النموذج الفرعي وتغيير زر ال ✔ ليكون بطريقة أسهل 🙂 وتم الإرسال بنجاح ولله الحمد 🙂 وفي البريد الإلكتروني :

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

استاذ @Eng.Qassim الف مبروك تستاهل كل خير

بعد اذن الاستاذ @محي الدين ابو البشر اخى @فوزى فوزى عدل السطر For i = 1 To UBound(d, 2): d(1, i) = 1 * Split(d(1, i), "/")(0): Next الى For i = 1 To UBound(d, 2): d(1, i) = 1 * Split(d(1, i), "/")(1): Next وايضا السطر x = Application.Match(1 * Split(ws.Range("E7"), "/")(0), d, 0) الى x = Application.Match(1 * Split(ws.Range("E7"), "/")(1), d, 0) عسي ان يكون طلبك ان شاء الله

التغيير لل LABEL عشان اقدر ارتب الادخال حسب بيانات الملف الاكسل مثلا textbox1 خلية A4 textbox1 خلية B4 textbox1 خلية C4 textbox1 خلية E4 ......................................وكذا الين النهاية بالنسبة لشلشة الدخول ابشر

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

أخي العزيز ممكن تستبدل بهذا الكود عسى ولعل Sub test() Dim ws As Worksheet: Set ws = Sheets("توزيع المبالغ") Dim sh As Worksheet: Set sh = Sheets("تجميع المبالغ") Dim a, b, c, m, d Dim x# Dim i&, ii& a = ws.Cells(6, 7).CurrentRegion b = sh.Cells(6, 1).CurrentRegion.Offset(2).Columns(1) ReDim c(1 To UBound(b) - 2, 1 To 2) m = ws.Range("E1") For i = 2 To UBound(a) For ii = 6 To UBound(a, 2) If (a(i, ii)) = "" Then Exit For x = Application.Match(a(i, ii), b, 0) c(x, 1) = IIf(c(x, 1) = "", a(i, 2), c(x, 1) & " + " & a(i, 2)) If a(i, 4) <= m Then c(x, 2) = c(x, 2) + a(i, 4) Else c(x, 2) = c(x, 2) + m: a(i, 4) = a(i, 4) - m End If Next Next d = sh.Range(sh.Cells(5, 4), sh.Cells(5, 4).End(xlToRight)).Value On Error Resume Next For i = 1 To UBound(d, 2): d(1, i) = 1 * Split(d(1, i), "/")(0): Next d = Application.Transpose(d) x = Application.Match(1 * Split(ws.Range("E7"), "/")(0), d, 0) With sh .Cells(6, 2).Resize(UBound(c)) = c .Cells(6, x + 3).Resize(UBound(c)) = Application.Index(c, 0, 2) End With End Sub

شكرا اخي

طريقة جميلة ومبتكرة 😞 انا استخدم احد الطابعات الافتراضية المجانية لطباعة ملف pdf من هذا الموقع: https://www.dopdf.com/ واحد الميزات اللي فيها ، بأنك تستطيع عمل الورقة بالحجم الذي تريده (تكتب طول وعرض الورقة). هناك طريقة اخرى استعملتها في احد برامجي ، وهي استخدام ورقة A4 ، ولكني استعملت سطرين او ثلاثة لكل سجل (فكر فيها كأنك تطبع نموذج مفرد ، بحيث توزيع الحقول يكون بطريقة منطقية ، وليس جنب بعضها البعض) 🙂 جعفر

في أحد برامجي التي بها حقول كثيرة جعلت تنسيق الصفحة على الحجم A3 بالعرض فشملت جميع الحقول.. وعند الحاجة للطباعة يتم تصدير الصفحة بصيغة PDF وحينها يسهل طباعتها بحجم A4 .

السلام عليكم الأخت الفاضلة الأفضل دائما إرفاق ملف ليسهل علي من يريد المساعدة عموما كترحيب وتحية لكي لأنها أولي مشاركاتك بالمنتدي أرفقت لكي ملفا أرجو أن بكون هو ماتريدين تفضلي المرفق أسماء الشيتات.rar

السلام عليكم أنظر طريقة سريعه في الفيديو المرفق فلتر (تصفية) ، فرز للفراغات عمل معادلة أن الخلية تساوي مافوقها مليء المعادلة لليمين ولأسفل أثناء الفلتر حذف الفلتر وممكن تعمل بعد كده نسخ / لصق خاص قيم فقط أنظر الفيديو المرفق Fill down.rar