اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

السلام عليكم ورحمة الله وبركاته

أساتذتي الكرام حفظكم الله

المطلوب حفظكم الله مكون من جزئين الأول في هذه الصفحة MAIN والآخر في الصفحة الثانية TOTALS

هذه صفحة رئيسية لادخال البيانات لكل العملاء

المطلوب الأول هو أنشاء صفحات بالكود بعد الضغط على زر ترحيل تكون بأسم كل العملاء في العمود C كلاً له صفحة خاصة باسمه مع أستخلاص بياناته فقط من هنا وترحيلها إلى صفحته الخاصة(مع إضافة عنوان أعلى كل صفحة بنفس أسم العميل حسب ماهو موضح في صفحة الفورم للعميل الأول) والبيانات هنا تتغير بالأضافة باستمرار (أي كلما تم الضغط على زر الترحيل تتحدث البيانات لكل العملاء دفعة واحدة كلاً إلى صفحته) وعند إضافة عميل جديد يتم أنشاء صفحة جديدة بأسمه مع ترحيل بياناته وهكذا

المطلوب الثاني في الصفحة الثانية TOTALS

وإذا كان بالأمكان أنشاء ملفات مستقلة (عوضاً عن الصفحات) لكل عميل داخل نفس الفهرس الموجود فيه الملف الرئيسي (أو فهرس خاص) يكون أفضل !!!

والله المستعان والموفق

جزاكم الله كل خير

أبو أنس ناصر حاجب

EXPORT SHIPPMENT PLAN.rar

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

السلام عليكم

هذا ملف حملته من المنتدى

بعثه الاخ زياد حفظه الله

فيه امكانيات كثيرة

ومنها ما طلبت

المرفق 2003

الترحيل لحسابات العملاء.rar

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

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

والسؤال هنا ماذا لو أردنا تجميع وتحديث متغيرات العملاء جميعا" بصفحة تقرير واحده وتشمل اكثر من حركة دائن ومدين للشهر الحالي وللسابق و اظهار الارصدة دائنة أو مدينه

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

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

والسؤال هنا ماذا لو أردنا تجميع وتحديث متغيرات العملاء جميعا" بصفحة تقرير واحده وتشمل اكثر من حركة دائن ومدين للشهر الحالي وللسابق و اظهار الارصدة دائنة أو مدينه

تقصد ميزان مراجعة ؟

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل عبد الله باقشير (أبا علي-خبور خير) حفظكم الله

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

بارك الله بك وفيك وفي ذريتك من بعدك.

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

أبو أنس

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

السلام عليكم ورحمة الله وبركاته

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

أرجو التعديل في الأكواد بحيث يتم نسخ أيضاً الأربعة الصفوف العلوية (لانها سوف تحتوي على إجماليات تقريرية ضرورية حتى يتم الاستفادة منه في حالة ملفات كشف الحساب أيضاً) لكل عميل مع إضافة إسم العميل في الخلية B1 كلاً حسب أسم ملفه أو صفحته(أي أسم العميل) وأيضاً أخفاء العمود الاول أو حذفه لكل عميل لأن اسمه سيكون مكرر بدون داعي.

طبعاً هذا حسب فهمي المتواضع واذا هنالك أفكار تطويريه له فأنتم الأقدر على الأستنتاج

والله الموفق والمستعان

المرفق

الترحيل لحسابات العملاء3.rar

أبو أنس

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

السلام عليكم

هذا كود صممته هدية مني لك

يقوم بانشاء الاورق داخل الملف


Option Explicit

Dim Rng As Range

Dim NamSheet As String



Sub kh_Add_Worksheets()

Dim Sh As Worksheet

Dim i As Long, Last As Long

Dim Msg As String

'''''''''''''''''''''''

On Error Resume Next

With Sheets("kh")

    Last = .Cells(.Rows.Count, 1).End(xlUp).Row

    If Last < 6 Then GoTo kh_ExT

    Set Rng = Range("B6:U" & Last)


End With

'''''''''''''''''''''''

kh_Application False

'''''''''''''''''''''''

With Rng.Offset(0, -1).Columns(1)

    For i = 1 To .Rows.Count

        NamSheet = Trim(.Cells(i, 1))

        If Len(NamSheet) = 0 Then GoTo 1

        NamSheet = kh_Replace(NamSheet)

        '''''''''''''''''''

        If IsError(Evaluate("'" & NamSheet & "'!A1")) Then

            Set Sh = ActiveWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))

            Sh.Name = NamSheet

            kh_CopyRng Sh, .ColumnDifferences(.Cells(i, 1))

        End If

        '''''''''''''''''''''

1:

    Next

    .Worksheet.Activate

End With

'''''''''''''''''''''''

kh_ExT:

kh_Application True

'''''''''''''''''''''''

Set Sh = Nothing

Set Rng = Nothing

On Error GoTo 0

End Sub


Sub kh_CopyRng(Sht As Worksheet, RngHidden As Range)

RngHidden.EntireRow.Hidden = True

'''''''''''''''''''''''''''''''''''''

Rng.SpecialCells(xlCellTypeVisible).Copy

''''''''''''''''''''''''''''

With Sht.Range("A6")

    .PasteSpecial xlPasteColumnWidths

    .PasteSpecial xlPasteValues

    .PasteSpecial xlPasteFormats

    Application.CutCopyMode = False


End With

'''''''''''''''''''''''''''''

RngHidden.EntireRow.Hidden = False

'''''''''''''''''''''''''''''''''''''

'نسخ رؤوس الاعمدة

With Sht

    .Range("B1").Value2 = NamSheet

    Rng.Worksheet.Range("B2:U5").Copy

    With .Range("A2")

        .PasteSpecial xlPasteFormats

        .PasteSpecial xlPasteFormulas

        Application.CutCopyMode = False

        .Select

    End With

End With

'''''''''''''''''''''''''''''''''''''


End Sub


Function kh_Replace(rName As String) As String

Dim itm

Dim myRep As String

myRep = rName

For Each itm In Array("/", "\", "*", ":", "؟", "?", "[", "]")

    myRep = Replace(myRep, itm, "")

Next

''''''''''''''''''''''''''''

myRep = Mid$(myRep, 1, 31)

''''''''''''''''''''''''''''

kh_Replace = myRep

End Function


Sub kh_Application(mbol As Boolean)

With Application

    .Calculation = IIf(mbol, -4105, -4135)

    .ScreenUpdating = mbol

End With

End Sub

المرفق 2003-2007

انشاء اوراق بحسابات العملاء.rar

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل نبيل وكريم الأخلاق عبد الله باقشير(أبا علي - خبور خير) حفظكم الله

هدية في غاية الروعة وأتمنى أن أستحقها.

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

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

أرجو مستقبلاً أن يتسع صدرك لأي أفكار تطويرية للملف (ليس الآن فلا أريد أن أستاثر بوقتك فهنالك من يستحق المساعدة أكثر مني).

أبو أنس ناصر حاجب

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

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

الاستاذ الفاضل عبد الله الخير

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

لوتفضلتم مشكورين بأيضاح كيفية عمل ذلك بنفس كود الترحيل لليوميه مثلا" ومنها لميزان مراجعه

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

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

الاستاذ الفاضل عبد الله الخير

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

لوتفضلتم مشكورين بأيضاح كيفية عمل ذلك بنفس كود الترحيل لليوميه مثلا" ومنها لميزان مراجعه

ارفق ملف في موضوع مستقل

لتنفيذ طلبك

ان شاء الله

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

بارك الله في استاذنا عبدالله باقشير

وبعد الاذن

الكود ادناه لحذف الاوراق التي تطابق اسمائها اسم العملاء

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


Sub AL_KHALEDI()

With Sheets("kh")

Set Rng = Range(.Cells(6, 1), .Cells(.Rows.Count, 1).End(xlUp))

End With

If Rng.Row < 6 Then GoTo Error

Application.ScreenUpdating = False

10

NamSheet = Trim(Rng(1))

For Each itm In Array("/", "\", "*", ":", "؟", "?", "[", "]")

NamSheet = Replace(NamSheet, itm, "")

Next

NamSheet = Mid$(NamSheet, 1, 31)

If Len(NamSheet) <> 0 Then

If Not IsError(Evaluate("'" & NamSheet & "'!A1")) Then

	 Application.DisplayAlerts = False

	 Sheets(NamSheet).Delete

	 Application.DisplayAlerts = True

End If

End If

On Error GoTo Error:

Set Rng = Rng.ColumnDifferences(Rng(1))

GoTo 10

Error:

Application.ScreenUpdating = True

Set Rng = Nothing

End Sub

انشاء اوراق بحسابات العملاء.rar

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل عبد الحافظ الخالدي حفظكم الله

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

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

أنتم أناس يعجز أمثالي إيفاكم حقكم ولكن كما هي عادتي أقول لكم أنتظروا الجزاء والثواب والأجر الأوفر والأكمل من واهب النعم والمتحكم فينا جميعاً العظيم الجبار.

أبو أنس

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

السلام عليكم ورحمة الله وبركاته

أساتذتي الكرام حفظكم الله

المطلوب أستخلاص نتائج الجدولين حسب ما هو واضح من عناوينهما في صفحة الـ Totals

أرجو أن تتم العملية بالأكواد حتى بالنسبة لأسماء العملاء

هنالك سيتم المقارنة بين الجدولين في حالة تطابق الجدولين نستيقن أن الترحيل للبيانات صحيح (لان كل جدول يستخلص بياناته من إتجاه مغاير)

أي توجيه لصالح تطوير الملف سوف يقدر عالياً

كود حذف جميع أوراق العملاء للأستاذ الخالدي حفظه الله بعد أن نقلته لاأعلم لماذا لا يعمل

هذه الجملة لم أفهم ما المقصود بها

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

حيث خلايا أسماء العملاء لاتحتوي على معادلات

وما المقصود بـ جملة لا يعطيان النتائج المطلوبة هل البيانات المرحلة أو فقط هنا المقصود حذف الأوراق.

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

If Sh.Name <> "Main" And Sh.Name <> "Totals" Then Sh.Delete

وذلك لأستثناء بعض الصفحات من الحذف

أعلم أن الكود خاص بحذف الصفحات التي تطابق أسمها أسماء العملاء

أرجو التوجيه والنصيحة

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

عذراً للقفز على الزمن ولكن حسب ما يقتضيه وقتكم لست في عجلة من أمري.

المرفق

Shipment Tracking New Version8.rar

أبو أنس

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

السلام عليكم

العمل يعطي نتائج صحيحة

بدون ان تقارن

اما عن تفسير عبارة اخي الحبيب الخالدي

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

عند احتواء خلايا العميل على معادلات

هنا المقصود به العمود 1

الذي فيه اسماء العملاء

اذا كانت هذه الاسماء تاتي عن طريق معادلة

في هذه الحالة

لن يعطيك نتائج صحيحة

هذا جعله اخي الخالدي تنبيه لمن قد يستخدم الكود بمثل هذه الحالة

وبالنسبة لكود الحذف

برضه صحيح

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

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

مثل ما اوردت انت في ردك الاخير

If Sh.Name <> "Main" And Sh.Name <> "Totals" Then Sh.Delete
او مثل الكود ادناه وبالنسبة لكود الخالدي للحذف فقط ياخذ نفس الاسماء التي اضيفت لاحقا بكود الانشاء من العمود 1 ====================================================== أيضاً عند الضغط على أنشاء صفحات للعملاء لمرة أخرى بعد أنشاءها لغرض تحديث البيانات أذا هنالك أدخالات جديدة في صفحة البيانات لا يحدث التحديث وأنما تحايلت عليه بطريقة أن أضفت كود حذف الصفحات قبل الكود كي تتم عملية التحديث أرجو حلها بطريقة أفضل. تم التعديل على كود الانشاء لعمل التحديث وايضا تعديل كود الحذف

Option Explicit


Sub kh_Delete_Worksheets()

Dim ibt As Boolean

Dim Sh As Worksheet

On Error GoTo 1

Application.DisplayAlerts = False

For Each Sh In ActiveWorkbook.Worksheets

Select Case Sh.Name

''''''''''''''''''''''''''''

'هنا تضع اسماء الاوراق التي لا تريد حذفها

Case "Main", "Totals"

'''''''''''''''''''''''

Case Else: Sh.Delete

End Select

Next Sh

1:

Application.DisplayAlerts = True

End Sub

وايضا تعديل في اكواد اخفاء واظهار الاعمدة

Sub sHide()

Dim Sh As Worksheet

For Each Sh In ActiveWorkbook.Worksheets

Select Case Sh.Name

''''''''''''''''''''''''''''

Case "Main", "Totals"

'''''''''''''''''''''''

Case Else

Sh.Range("F1,K1:R1").EntireColumn.Hidden = True

End Select

Next

End Sub

Sub sUnHide()

Dim Sh As Worksheet

For Each Sh In ActiveWorkbook.Worksheets

Select Case Sh.Name

''''''''''''''''''''''''''''

Case "Main", "Totals"

'''''''''''''''''''''''

Case Else

Sh.Range("F1,K1:R1").EntireColumn.Hidden = False

End Select

Next

End Sub

المرفق 2003

Shipment Tracking New Version8_1.rar

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي النبيل الفاضل عبد الله باقشير (أبا علي - خبور خير) حفظكم الله

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

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

حالياً أقوم ببعض التعديلات لصالح تطوير الملف ثم عرضه عليكم لاحقاً للتصحيح (طمعاً في كرمكم)

أبو أنس

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا علي حفظكم الله

أرجو مراجعة الملف المرفق:

في صفحة الـ Main المعادلة في الخلية C3 عملت على الأبطاء من الكود بشكل كبير أرجو حل المعظلة بمعادلة بديلة أو تغيير وظيفتها بالكود.

أرجو مراجعة صفحة الـ Totals فقد عملت عليها على قدر فهمي وتجميعي للأكواد(فهي مهمة لي كما تلاحظ لاستخلاص النتائج).

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

Shipment Tracking New Version10.rar

أبو أنس

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل حفظكم الله

عطفاً على أخر رد لقد أكتشفت أيضاً خطأ في الكود(الذي أضفته أنا) الخاص بأستخلاص أسماء العملاء بدون تكرار حيث أنه كرر أيضاُ أسم العميل الثاني.

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

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

أبو أنس

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل حفظكم الله

عطفاً على أخر رد لقد أكتشفت أيضاً خطأ في الكود(الذي أضفته أنا) الخاص بأستخلاص أسماء العملاء بدون تكرار حيث أنه كرر أيضاُ أسم العميل الثاني.

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

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

أبو أنس

المرفق 2003

1- تعديل كود اضافة الاوراق الى كود جديد

يضيف الاوراق بدون مشاكل المعادلات المذكورة سابقا

2- اضافة كود جديد للمجاميع في وزرقة توتال

Shipment Tracking New Version10_1.rar

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

السلام عليكم ورحمة الله وبركاته

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

جمعة مباركة.

أدام الله عليكم الصحة والعافية وتقبل منكم صالح الأعمال وشملكم بعفوه ومغفرته.

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

بارك الله بك وفيك وفي ذريتك من بعدك.

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

مقصدي الوصول بالملف إلى أقصى الممكن ليستفيد منه من يريد

أبو أنس

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

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل أبا علي (عبد الله باقشير - خبور خير) حفظكم الله

أرجو المساعدة في التالي:

1. تجميد الألواح لكل صفحات العملاء على نفس شاكلة صفحة الـ Main

2. طباعة صفحات العملاء تكون أختياريه من قائمة في ملف (أو بواسطة فورم) يتم من خلالها التحديد لبعض أو كل العملاء للطباعة دفعة واحدة وبأمر واحد أو من خلال Check Box في صفحة الـ Totals الأمر متروك لك.

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

خذ وقتك حسب الأستطاعة.

تقبل فائق التقدير والأحترام والشكر

أصبحتم لدي أساتذتي الكرام من المخصصين بالدعاء أثناء السجود والله المستجيب (على أن لا ينظر إلى أعمالنا كسبب أستجابة الدعاء ولكن إلى ضعفنا أمامه فمهما عملنا لله فلا نستطيع نوفيه ولو نعمة واحدة من نعمه علينا).

أرجو أعتماد هذا المرفق في التعديل

Shipment Tracking New Version12.rar

أبو أنس

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

السلام عليكم

أرجو المساعدة في التالي:

1. تجميد الألواح لكل صفحات العملاء على نفس شاكلة صفحة الـ Main

2. طباعة صفحات العملاء تكون أختياريه من قائمة في ملف (أو بواسطة فورم) يتم من خلالها التحديد لبعض أو كل العملاء للطباعة دفعة واحدة وبأمر واحد أو من خلال Check Box في صفحة الـ Totals الأمر متروك لك.

شاهد المرفق 2003

Shipment Tracking New Version12.rar

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

السلام عليكم ورحمة الله وبركاته

ياسيدي وأستاذي النبيل عبد الله باقشير حفظكم الله ونور بصركم وبصيرتكم بنور الأيما ن وجعل منزلكم في الفردوس الأعلى جوار الحبيب المصطفى سيد ولد أدم محمد أبن عبد الله اللهم أجعل له في الدنيا نوراً وقبولاً عند الناس أجمعين وأسالك ربي المحبة له وأن تظله بظلك في الدنيا ويوم يقوم الأشهاد ومتعه بالصحة والعافية أبداً ما أحييته وأحفظ له ذريته من بعده إلى يوم البعث وأجعلهم من حملة لواء الحق والأسلام ولا تجعل للشيطان عليهم سبيلا.

اللهم أني أسالك بأسمك الأعظم وكل أسمائك الحسنى أن تستجيب دعائي ولا تنظر إلى ذنوبي ولكن إلى قوتك وجبروتك وعظمتك ورحمتك بنا حتى من أنفسنا.

أبو أنس ناصر أحمد حاجب

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
×
×
  • اضف...

Important Information