اذهب الي المحتوي
أوفيسنا

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


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

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

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

1833123028_.JPG.5456fc262150883606c0f1057bbf17f7.JPG

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

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

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

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

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

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

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

1949114518_.jpg.ef4f9fcc204e7bfd887f8ba981b4729f.jpg

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

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

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

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

 

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

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

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

 

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

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

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

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

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

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

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

image.png.0397309cd332048048bcbe7da4b17dcb.png

 

 image.png.cfcf6ed957767f65ce0d5dbd3247bdb4.png

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

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

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

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

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

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

151480712_.jpg.8ed688f0a7d2cb1667e033a679618193.jpg

الترحيل.xlsm

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

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

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

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

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

 

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

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

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

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

151480712_.jpg.8ed688f0a7d2cb1667e033a679618193.jpg

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

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

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

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

الترحيل2.xlsm

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

  • 2 weeks later...

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

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

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

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

 

ملحوظة

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

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

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

 

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

image.png.0689e07c7760430af01b843dee6ecb2b.png

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

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

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

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

للرفع 

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

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

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

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