برجاء المساعده فى تعديل هذا الملف

هانى حرحش · نوفمبر 12, 2015

اعمل باحد المؤسسات ويتحتم علي طباعة اوامر صرف مثل الموجوده بالمرفقات من الشيتات الاخرى في نفس الملف لعدد قد يصل الي 200 عميل في كل شيت ولا استطيع تكرار تلك الايصالات يدويا ... لذا ارجو من عمالقة المنتدى المساعده في تكرار اوامر الصرف تلقائيا على ان يحمل كل ايصال صرف اسم المصلحة الموجود بها اسم العميل او الطباعة تلقائيا لنفس الاعداد الموجوده او ما يمكن ان يضاف مستقبلا على نفس النموذج المرفق بدون زيادة الايصالات عن صفحة A4 واحده تحمل امرين لعميلين وتكرار امر الطباعه فقط لكل العملاء مع طباعة اسم المصلحه بكل ايصال يخصها .. وشكرا للجميع .

المصنف1.rar

تم تعديل نوفمبر 12, 2015 بواسطه هانى حرحش
تكرار المرفق

ياسر خليل أبو البراء · نوفمبر 12, 2015

الطلب غير واضح بعض الشيء أخي الكريم هاني

بدايةً .. ما المطلوب عمله ؟؟ هل المطلوب كود يقوم بطباعة أذون الصرف كلها مرة واحدة ؟؟؟

السؤال الثاني ..ما هي ورقة العمل المطلوب جلب البيانات منها ...؟؟ مصلحة 1 ولا 2 ولا 3 ... ولا جميع المصالح ..؟؟

ولما لا توضع بيانات جميع المصالح في ورقة عمل واحدة ويضاف لها عمود يذكر فيه اسم المصلحة (هذا أفضل من وجهة نظري)

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

هانى حرحش · نوفمبر 13, 2015

اخي ابو البراء ... مجهودك مشكور ... واعتذر عن الغموض... وتوضيحا لذلك :

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

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

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

ياسر خليل أبو البراء · نوفمبر 13, 2015

أخي الكريم هاني

ممكن توضح بالتفصيل الخلايا في نموذج الإيصال التي ستتغير مع كل إذن صرف

لونها بلون محدد لتسهيل معرفة المطلوب ..

وسؤال أخير : هل ستقوم بطباعة كل هذا العدد مرة واحدة ؟؟؟

هانى حرحش · نوفمبر 13, 2015

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

المصنف2.rar

تم تعديل نوفمبر 13, 2015 بواسطه هانى حرحش

ياسر خليل أبو البراء · نوفمبر 13, 2015

Sub CreateOneSheet()
    Dim SheetsArr, SH As Worksheet, WS As Worksheet
    Dim I As Long, LR As Long, Count As Long
    
    Set WS = Sheets("اذون الصرف")
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
        If Not Evaluate("ISREF('Temp'!A1)") Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp"
        Sheets("Temp").Cells.Clear
        
        SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3")
        For I = 0 To UBound(SheetsArr)
            For Each SH In Sheets
                If SH.Name = SheetsArr(I) Then
                    With SH
                        LR = IIf(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row < 2, 1, Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row + 1)
                        .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Temp").Range("A" & LR)
                        Count = Application.WorksheetFunction.Count(Sheets("Temp").Range("A" & LR & ":A" & Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row))
                        Sheets("Temp").Range("E" & LR).Resize(Count) = .Name
                        Sheets("Temp").Range("F" & LR).Resize(Count).Formula = "=Ar_WriteDownNumber(" & Sheets("Temp").Range("D" & LR).Address(0, 0) & ", ""جنيه"", ""قرش"")"
                    End With
                End If
            Next SH
        Next I
        
        With Sheets("Temp")
            For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 2
                WS.Range("G4") = .Cells(I, "E")
                WS.Range("D6") = .Cells(I, "F"): WS.Range("D14") = .Cells(I, "F")
                WS.Range("C7") = .Cells(I, "C")
                WS.Range("B11") = .Cells(I, "D"): WS.Range("B14") = .Cells(I, "D")
                WS.Range("D12") = .Cells(I, "B")
                
                
                WS.Range("G24") = .Cells(I + 1, "E")
                WS.Range("D26") = .Cells(I + 1, "F"): WS.Range("D34") = .Cells(I + 1, "F")
                WS.Range("C27") = .Cells(I + 1, "C")
                WS.Range("B31") = .Cells(I + 1, "D"): WS.Range("B34") = .Cells(I + 1, "D")
                WS.Range("D32") = .Cells(I + 1, "B")
                
                WS.PrintPreview
            Next I
            .Delete
        End With
        
        MsgBox "Done", 64
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

أخي الكريم هاني حرحش ..

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

في السطر التالي قرب نهاية الكود

WS.PrintPreview

ستقوم باستبدال كلمة PrintPreview بكلمة Printout للطباعة (عملت معاينة فقط في الكود ..) يمكنك تغييرها لتقوم بالطباعة بشكل مباشر

إليك الكود المستخدم

...

برجاء الانتباه ..أعتقد أنه لن تقوم بعمل معاينة لكل العملاء .. ولذلك لكي توقف عمل الكود اضغط Ctrl + Pause Break للخروج من الإجراء

أتمنى أن يكون المطلوب إن شاء الله

تقبل وافر تقديري واحترامي

Create One Sheet YasserKhalil.rar

هانى حرحش · نوفمبر 14, 2015

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

ياسر خليل أبو البراء · نوفمبر 14, 2015

أخي الكريم هاني

الحمد لله أن نال الملف إعجابك ..

اقتباس

نعم اريد طباعة ايصالات كل مصلحه مره واحده ولو امكن طباعة كل المصالح مرة واحده .

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

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

SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3")

هذا السطر من خلاله يمكنك وضع أوراق العمل المطلوب العمل عليها بنفس الشكل ..

Sub CreateOneSheet()
    Dim SheetsArr, SH As Worksheet, WS As Worksheet
    Dim I As Long, LR As Long, Count As Long
    Dim strSheet As String
    
    Set WS = Sheets("اذون الصرف")
    strSheet = WS.Range("K7").Value
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
        
        If Not Evaluate("ISREF('Temp'!A1)") Then Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Temp"
        Sheets("Temp").Cells.Clear
        
        If strSheet = "كل المصالح" Then
            SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3")
            For I = 0 To UBound(SheetsArr)
                For Each SH In Sheets
                    If SH.Name = SheetsArr(I) Then
                        With SH
                            LR = IIf(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row < 2, 1, Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row + 1)
                            .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Temp").Range("A" & LR)
                            Count = Application.WorksheetFunction.Count(Sheets("Temp").Range("A" & LR & ":A" & Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row))
                            Sheets("Temp").Range("E" & LR).Resize(Count) = .Name
                            Sheets("Temp").Range("F" & LR).Resize(Count).Formula = "=Ar_WriteDownNumber(" & Sheets("Temp").Range("D" & LR).Address(0, 0) & ", ""جنيه"", ""قرش"")"
                        End With
                    End If
                Next SH
            Next I
        Else
            With Sheets(strSheet)
                LR = IIf(Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row < 2, 1, Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row + 1)
                .Range("A1").CurrentRegion.Offset(1).Copy Sheets("Temp").Range("A" & LR)
                Count = Application.WorksheetFunction.Count(Sheets("Temp").Range("A" & LR & ":A" & Sheets("Temp").Cells(Rows.Count, "A").End(xlUp).Row))
                Sheets("Temp").Range("E" & LR).Resize(Count) = .Name
                Sheets("Temp").Range("F" & LR).Resize(Count).Formula = "=Ar_WriteDownNumber(" & Sheets("Temp").Range("D" & LR).Address(0, 0) & ", ""جنيه"", ""قرش"")"
            End With
        End If
        
        With Sheets("Temp")
            For I = 1 To .Cells(Rows.Count, 1).End(xlUp).Row Step 2
                WS.Range("G4") = .Cells(I, "E")
                WS.Range("D6") = .Cells(I, "F"): WS.Range("D14") = .Cells(I, "F")
                WS.Range("C7") = .Cells(I, "C")
                WS.Range("B11") = .Cells(I, "D"): WS.Range("B14") = .Cells(I, "D")
                WS.Range("D12") = .Cells(I, "B")
                
                
                WS.Range("G24") = .Cells(I + 1, "E")
                WS.Range("D26") = .Cells(I + 1, "F"): WS.Range("D34") = .Cells(I + 1, "F")
                WS.Range("C27") = .Cells(I + 1, "C")
                WS.Range("B31") = .Cells(I + 1, "D"): WS.Range("B34") = .Cells(I + 1, "D")
                WS.Range("D32") = .Cells(I + 1, "B")
                
                WS.PrintPreview
            Next I
            .Delete
        End With
        
        MsgBox "Done", 64
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

أخي الكريم هاني

تم إنشاء قائمة منسدلة في الخلية K7 ومصدرها في العمود N وعملت إخفاء للعمود

يمكنك الآن اختيار أي مصلحة أو كل المصالح كما ترغب

Create One Sheet YasserKhalil V2.rar

هانى حرحش · نوفمبر 14, 2015

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

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

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

جزاكم الله خيرا واتمنى الا اكون قد اثقلت كاهلك معي .

ياسر خليل أبو البراء · نوفمبر 14, 2015

أكرر مرة أخرى أخي الكريم هاني

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

SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3")

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

لا يمكن تخمين حدوث مشكلة قبل حدوثها إذ أنني لا أدري ما هو شكل الملف بعد التعديل ...!!

أعتقد من الأفضل عمل الملف كما تريده تماماً ثم طرح نموذج منه لمراجعة الكود مع التعديل أما التخمين فاعذرني لا يمكنني التخمين ... :wink2:

أرجو أن تكون اتضحت الصورة

تقبل تحياتي

هانى حرحش · نوفمبر 14, 2015

شكرا اخي واسف على الازعاج ساقوم بانهاء الملف واجرب واذا حدث معي شيء ساخبرك ... وجزاكم الله خيرا

ياسر خليل أبو البراء · نوفمبر 14, 2015

تأكد أخي الكريم هاني حرحش

أننا لن نتخاذل معك .. فقط التزم بالتوجيهات وليكن عنوان موضوعاتك عنوان واضح ومعبر عن الطلب ..

والأخوة جميعهم في خدمة إخوانهم

تقبل تحياتي

هانى حرحش · نوفمبر 15, 2015

اخي العزيز ابو البراء ... نسيت امرا لم الاحظه الا عندما جئت اضيف بيانات للبرنامج واحاول الطباعه اليوم للتجربه عمليا ... وهو انني املك اكثر من طابعه بالعمل ولا اطبع الايصالات على الطابعه الاساسيه الموصله والا فتراضيه للجهاز بل اطبعها في مكان اخر على طابعه اخرى ... فما الحل .. فعندما قمت بتجربه ضغيره اليوم فوجئت بتلك اللنتيجه ... هل ممكن تفادي ذلك ام ينبغي ان اغير الطابعه الافتراضيه للجهاز عند كل مره استخدم فيها هذا الملف ... ارجو الرد ... واعذرني فأنا لا اجيد الاكواد .

ياسر خليل أبو البراء · نوفمبر 15, 2015

أخي الكريم هاني

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

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

Sub Test()
    Range("A1").Value = Application.ActivePrinter
End Sub

هانى حرحش · نوفمبر 21, 2015

اخي ابو البراء مشكور على مجهودك .... واعتذر عن التأخير .... ولكن كان ذلك لظروف صحيه .

بالنسبه لاختيار الطابعه عند الطباعه فقد استخدمت هذا الكود :

Application.Dialogs(xlDialogPrinterSetup).Show

وقمت بوضعه بعد هذه الاوامر :

Sub CreateOneSheet()
    Dim SheetsArr, SH As Worksheet, WS As Worksheet
    Dim I As Long, LR As Long, Count As Long
    Dim strSheet As String
    
    Set WS = Sheets("اذون الصرف")
    strSheet = WS.Range("K7").Value
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

واصبح يظهر الطابعات الموجوده والموصله مباشر او بالشبكه للاختيار منها فهل مكانه هنا مناسب ام يستحسن وضعه في مكان اخر ؟

ثانيا : اود استخدام هذا الامر لوضع اسماء الشيتات فى الخلايا التي تستخدمها خلية اختيار المصالح ولا اعرف اين يتم وضعه

Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Sheets
    Range("M" & ws.Index).Value = ws.Name
Next ws
Columns("M:M").NumberFormat = ";;;"
LR = Sheets("Master").Range("m" & Rows.Count).End(xlUp).Row
With Range("N2").Validation
    .Delete
    .Add xlValidateList, Formula1:="=M2:M" & LR
End With
End Sub

وهل هذا الامر سليم ام يحتاج الى تعديل ؟

وهل يمكن استخدامه للتعديل على هذا السطر تلقائيا ؟

SheetsArr = Array("مصلحه 1", "مصلحه 2", "مصلحه 3")

شكرا لصبركم ... وجعلكم الله عونا للجميع .

تم تعديل نوفمبر 21, 2015 بواسطه هانى حرحش
تصحيح الكود

ياسر خليل أبو البراء · نوفمبر 21, 2015

أخي الكريم هاني

شفاكم الله وعافاكم .. لا بأس طهور إن شاء الله

سأبدأ بتناول ما طلبته نقطة نقطة حيث أنني أتوه في كثرة النقاط ..

أولاً فيما يخص اختيار الطابعة ..هذا أمر لا بأس به ، ولكن إذا كانت الطباعة من طابعة محددة فأفضل عدم الاختيار في هذه الحالة ، واللجوء مباشرةً من خلال الكود للطباعة

لمعرفة الطابعة ..قم أولاً من خلال لوحة التحكم بالدخول على Printers ثم كليك يمين على الطابعة المراد الطباعة من خلالها ثم اختر Set As default (هذا الإجراء بشكل مبدئي فقط ..لمعرفة نوع الطابعة والبورت الموصل بها ...أي أنه يمكنك بعد ذلك تغيير الطابعة الافتراضية .. أي أن هذه الخطوة لمعرفة نوع الطابعة والبورت الموصل بها)

المهم ..بعد تلك الخطوة قم بفتح ملف إكسيل ونفذ السطر الذي أشرت إليه من قبل وهو

Sub Test()
    Range("A1").Value = Application.ActivePrinter
End Sub

سيظهر معك في الخلية A1 اسم الطابعة وفي نهاية اسم الطابعة البورت الموصل بها

خذ القيمة في الخلية A1 نسخ ثم قم بوضع السطر التالي في كودك قبل سطر الطباعة مباشرةً

Application.ActivePrinter = "اسم الطابعة اللي أخذته نسخ ما بين أقواس تنصيص"

يمكنك الذهاب إلى لوحة التحكم ثم Printers مرة أخرى وتغيير الطابعة الافتراضية إلى ما كانت عليه .. لا تشغل بالك

السطر الذي أضيف في الكود لا يغير الطابعة الافتراضية ، لا تقلق حيال هذا الأمر ، فقط يغير الطابعة النشطة أي التي ستتم عملية الطباعة من خلالها

جرب بنفسك وشوف النتائج

***********************

ثانياً : فيما يخص الكود المرفق يتم وضعه في حدث المصنف ThisWorkbook ولكن انتبه أن الكود يضيف كل أوراق العمل الموجودة في المصنف دون استثناء

وقمت بتعديل الكود لأن به خطأ بسيط وهو بداية النطاق M2 يجب أن يكون M1 (إلا إذا كانت ورقة العمل Master هي الورقة الرئيسية رقم 1 وتريد عدم إدراجها في القائمة المنسدلة)

Private Sub Workbook_Open()
    Dim WS As Worksheet, LR As Long
    
    For Each WS In Sheets
        Range("M" & WS.Index).Value = WS.Name
    Next WS
    
    Columns("M:M").NumberFormat = ";;;"
    LR = Sheets("Master").Range("M" & Rows.Count).End(xlUp).Row
    
    With Range("N2").Validation
        .Delete
        .Add xlValidateList, Formula1:="=M1:M" & LR
    End With
End Sub

طبعاً الكود يقوم بعمل حلقة تكرارية لكل أوراق العمل في المصنف ثم يعتمد على رقم الفهرس لكل ورقة عمل ويضيف في العمود M أسماء أوراق العمل ، ثم من خلال الكود يتم إدراج هذه الأسماء في القائمة المنسدلة في الخلية N2 ...

***********************

ثالثاً : ارفق ملفك الأصلي وعدد أوراق العمل فيه أو أمر آخر يمكنك إدراج كل أوراق العمل في هذه القائمة إلا ما تقوم باستثنائه أي اذكر لنا أسماء أوراق العمل المراد عدم التعامل معها من خلال المصفوفة لكي يتم تجنبها

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

تقبل تحياتي

تسجيل الدخول

برجاء المساعده فى تعديل هذا الملف

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

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

هانى حرحش

ياسر خليل أبو البراء

Join the conversation

محتوي مشابه

طلب مساعده أبحث عن دالة تنقل البيانات من شيت1 إلى شيت2 حسب رأس الجدول دون تكرار

ملف اكسيل لحساب فى محل كمبيوتر

حساب نسبة الخصم المكتسب على مخزون آخر المده ( عنوان معدل )

طلب : المساعده فى ملفات تعليمية للماكرو

طلب : المساعده فى ملفات اكسيل لمدير الحسابات

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information