مساعدة في تجميع أسماء العملاء والحسابات بدون تكرار وتجميع أرصدتهم المدينة والدائنة

[حاتم عيسى]

بسم الله الرحمن الرحيم

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

ولسيادتكم جزيل الشكر والعرفان

الحسابات على عيسى 2.xlsx

[حسين مامون]

ربما يكون بالمرفق ما تريد

الحسابات على عيسى 2.xlsm

[حاتم عيسى]

الأستاذ الفاضل المحترم : حسين مامون

شكرا لحضرتك على الاهتمام والرد .

أعتذر من حضرتك ممكن حضرتك تضع الكود في مشاركة حيث أن الكلمات العربي تغيرت إلى حروف ورموز غير معروفة والكود لا يعمل .

2 - هل من الممكن أن يتم عمل تنسيقات للسطرين الخاصين بالإجماليات من حدود مثل باقي الصفوف وكذلك عمل لون تعبئة لخلايا المجموع والصافي .

3 - هل من الممكن عمل زر طباعة على أن يكون مطاطي على حسب عدد سطور صفحة الطباعة المرحلة من صفحة Data يتغير بتغير حجم الصفحة ؟

وشكرا جزيلا لحضرتك وجعل الله جميع أعمالكم في موازين حسناتكم

تم تعديل يناير 8, 2021 بواسطه حاتم عيسى

[حسين مامون]

Option Explicit

Sub test()
Dim lr, c, x, r, lr2
Dim ws As Worksheet
Set ws = Sheets("DATA")
Dim ws2 As Worksheet
Set ws2 = Sheets("الطباعة")

c = ws.[d3]
r = 6
Application.ScreenUpdating = False
With ws
ws2.Range("a6:d1000").ClearContents
ws2.Range("a6:d1000").Borders.LineStyle = 0

lr = .Cells(Rows.Count, 1).End(3).Row
For x = 6 To lr
Select Case .Cells(x, 1).Value2: Case c
ws2.Range("b4").Value = .Cells(x, 1).Value
ws2.Range("a" & r).Value = .Cells(x, "e").Value
ws2.Range("a" & r).Offset(, 1).Value = .Cells(x, "d").Value
ws2.Range("a" & r).Offset(, 2).Value = .Cells(x, "b").Value
ws2.Range("a" & r).Offset(, 3).Value = .Cells(x, "c").Value
ws2.Range("a" & r).Resize(, 4).Borders.LineStyle = xlDot
r = r + 1
End Select

Next x
lr2 = ws2.Cells(Rows.Count, 1).End(3).Row + 2
ws2.Range("b" & lr2) = "اجمالي"
ws2.Range("c" & lr2) = WorksheetFunction.Sum(ws2.Range("c6:c" & r - 1))
ws2.Range("d" & lr2) = WorksheetFunction.Sum(ws2.Range("d6:d" & r - 1))
If ws2.Range("c" & lr2) > ws2.Range("d" & lr2) Then
ws2.Range("b" & lr2).Offset(1) = "اجمالي مدين"
ws2.Range("c" & lr2).Offset(1) = ws2.Range("c" & lr2) - ws2.Range("d" & lr2)
ElseIf ws2.Range("c" & lr2) < ws2.Range("d" & lr2) Then
ws2.Range("b" & lr2).Offset(1) = "اجمالي دائن"
ws2.Range("c" & lr2).Offset(1) = ws2.Range("d" & lr2) - ws2.Range("c" & lr2)
End If
'====================
ws2.Range("a" & lr2).Resize(1, 4).Interior.Color = 49407
ws2.Range("a" & lr2 + 1).Resize(1, 4).Interior.ThemeColor = xlThemeColorAccent5
    With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeTop)
        .LineStyle = xlDot
        .Weight = xlThin
    End With
    With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeBottom)
        .LineStyle = xlDot
        .Weight = xlThin
    End With
    With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeRight)
        .LineStyle = xlDot
        .Weight = xlThin
    End With
    With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeLeft)
        .LineStyle = xlDot
        .Weight = xlThin
    End With
    With ws2.Range("a" & lr2).Resize(2, 4).Borders(xlEdgeTop)
        .LineStyle = xlDot
        .Weight = xlThin
    End With
'======================
ws2.Activate
End With
Application.ScreenUpdating = True

End Sub

 

[حسين مامون]

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

Option Explicit

Sub printDOC()
Dim LR
LR = Cells(Rows.Count, 2).End(3).Row
If MsgBox("هل تريد طباعة التقرير", vbExclamation + vbYesNo) = vbYes Then
Range("a1:d" & LR).PrintPreview
End If

End Sub

 

[حاتم عيسى]

الأستاذ الفاضل المحترم : حسين مامون

بارك الله في حضرتك وسلمت يداك مجهود مشكور وجعله الله في ميزان حسناتك .

طلب أخير إن شاء الله

في حالة أن تكون الفاتورة أو البيان المرحل للطباعة عدد أسطرة 3 ثلاثة مثلا يكون الإجمالي ملون كما أنا طلبت وعند ترحيل فاتورة أو بيان أكثر من عدد الأسطر السابقة تظل التنسيقات الملونة في الأسطر وبها بيانات وتلون الأسطر الأخيرة هل من الممكن مسح التنسيقات عند الترحيل ووضعها في مكانها الصحيح .

وشكرا جزيلا لحضرتك وبارك الله فيك

مرفق صورة للتوضيح بما يحدث

 

 

[حسين مامون]

اضف هذا السطر في الكود كما في الصورة

ws2.Range("a6:d1000").Interior.Color = xlNone

الصورة

[حاتم عيسى]

بسم الله الرحمن الرحيم

الأستاذ : حسين مامون  المحترم

هل من الممكن أن نضع كودي الترحيل والطباعة لزر على الفورم  حتى يتم ترحيل البيانات وعمل معاينة للطباعة كما هو موجود في الكودين الخاصين بحضرتك .

بحيث عند الضغط على زر طباعة تقرير العميل الحالي يتم وضع اسم العميل الحالي الموجود في الخلية الأولى يوضع في الخلية D3 في الشيت Data ويتم ترحيل بيانات العميل الذي تم اختياره إلى صفحة الطباعة Print ثم يتم تنفيذ كود الطباعة .

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

الترحيل.xlsm

[حسين مامون]

اخي الكريم 

كان عليك طلب هذا منذ المشاركة الاولى 

عليك بطلب جديد في مشاركة جديدة ولكن حاول اختصار طلبك في فورم نظيف بدون مشاكل.

تحياتي

[حاتم عيسى]

شكرا أستاذي الفاضل المحترم

قمت بتنفيذ ( " تم ترحيل بيانات العميل الذي تم اختياره إلى صفحة الطباعة Print ثم يتم تنفيذ كود الطباعة " ) عند الضغط على الزر الخاص بالطباعة

باقي ربط الخلية الخلية D3 في الشيت Data بالقيمة الموجودة في Textbox1 الموجود على الفورم .

عموما بارك الله في حضرتك وإن شاء الله أقوم بعمل موضوع جديد أطلب فيه ما هو باق .

 

[حسين مامون]

ضع هذا الشيء في حدث تيكستبوكس1 change

cheets("DATA").range("d3").value= textbox1.value

وهذا ان كان ما دكرته صحيح

[حاتم عيسى]

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

حيث عند الضغط على زر طباعة تقرير العميل الحالي يتم وضع اسم العميل الحالي الموجود في الخلية الأولى يوضع في الخلية D3 في الشيت Data ويتم ترحيل بيانات العميل الذي تم اختياره إلى صفحة الطباعة Print ثم يتم تنفيذ كود الطباعة .

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

ما أريد ربطه هو خانة حساب عميل الموجوده في Frame1 الموجود على الفورم

اللي هو على سبيل المثال حساب العميل : محمد اللي موجود بالصورة السابقة

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

ولسيادتكم جزيل الشكر والعرفان

الترحيل2.xlsm

[عبدالله بشير عبدالله]

السلام عليكم

محاولة ربما فيها الافادة

  الترحيل2 (3).xlsm

[حاتم عيسى]

بسم الله الرحمن الرحيم

السادة الأفاضل المحترمين مشرفي ورواد المنتدى المحترمين

بعد التحية والاحترام لسيادتكم جميعًا

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

 

ملحوظة

من بعض الشروحات الموجودة بالمنتدى من السادة الأفاضل مشرفي ورواد المنتدى المحترمين قد توصلت إلى حل قد يكون أقرب إلى الصح.

وما أطلبة من سيادتكم التكرم بتحميل الملف الجديد والتعديل علية بما هو أنسب وكذلك عمل أبجدة تلقائية للعمود المرحل إليه البيانات العمود ( I ) .

وبارك الله فيكم جميعا ونفع بكم وبعلمكم الأمة العربية جميعا .

 

صورة من الملف بالمطلوب

مرفق الملف المطلوب العمل عليه

وشكرا لسيادتكم جميعا مقدمًا .

برنامج الحسابات الجديد 05-01-2021 للتجميع.xlsm

[حاتم عيسى]

للرفع 

برجا مساعدتي في ابجدة المحتوى في العمود I تلقائيا.

جزاكم الله كل خير و نفعكم الله بعلمكم وزادكم الله علما .