أبو شرف قام بنشر أغسطس 18, 2013 قام بنشر أغسطس 18, 2013 بسم الله الرحمن الرحيم اخواني اعضاء هذاالمنتدى الكرام تحية طيبة ارفق لكم نسخة من برنامج محاسبي بسيط وهو يشبه السجل المحاسبي العام المطلوب مساعدة من اصحاب الخبرة لجعل الصحفة يتم الترحيل لها عن طريق فورمة القيمة بحيث عملية قيد ثم ترحيل اضاعة على عمل ميزاان مراجعة بالمجاميع وألأرصدة وتقبلوا فائق التقدير اخوكم ابو شرف الحسابات.rar 1
رعد داود قام بنشر أغسطس 19, 2013 قام بنشر أغسطس 19, 2013 السلام عليكم ورحمة الله وبركاته أهلا" بكم في هذا المندى الرائع ومرحبا" لو تحاول تصميم نموذج لصفحة المستندات ,, ونموذج لميزان المراجعة الذي تريده أنت يمكن مساعدتك ,,, وعلى العموم هناك مواضيع كثيرة ونماذج كثيرة في هذا المندى لطلبكم وللمساعده أرفق ملف لأحد الأساتذه للحسابات اليوميه اليومية العامة.rar
أبو شرف قام بنشر أغسطس 19, 2013 الكاتب قام بنشر أغسطس 19, 2013 (معدل) اخي العزيز يعجز لساني عن الشكر وفقك الله انت وجميع الأعضاء والى كل شخص بذل مجهود في هذا المنتدى الكريم واني اششششششششكر من كل قلبي فعلا هذا ما كنت اتمنى بالضبط ولو احتاجيت بعض التعديلات سوف اكتب لك وتحملني قليلا . اخوكم ابو شرف فقط عني ملاحظة ميزان المراجعة يخرج عندي بالارصدة فقط ارجو ان يخرج عندي مجاميع وارصيدة لو بالو بالأمكان مع التقدير تم تعديل أغسطس 19, 2013 بواسطه أبو شرف
الفرس قام بنشر أغسطس 20, 2013 قام بنشر أغسطس 20, 2013 الاخ الكريم ابو شرف السلام غليكم ميزان المراجعة يتم الترحيل من اليومية العامة المجاميع فقط اما الارصدة فيتم تسجيلها من الاساتذة المساعدة وفى النهاية الفرق بين المجاميع لابد ان يتساوى مع الفرق بين الارصدة وهذا من دواعى الرقابة وضبط الحسابات فى المحاسبة
أبو شرف قام بنشر أغسطس 25, 2013 الكاتب قام بنشر أغسطس 25, 2013 الأخوة الأعزاء الكرام هذه مشاركة لاحد الزملاء في المنتدى وقد استفدنا منها جميعا ولكن هناك مشكلة اتمنى التغلب عليها وهي انه عند الترحيل لحساب واحد المفروض الطرف المدين يأخذ اسم حساب والطرف الدائن يأخذ اسم حساب وعند ادراج اكثر من حساب للطرف الوحد يظهر اسم الحساب ( مذكورين ) واذا الحساب طرف واحد يظهر اسم الحساب حسب التوجيه وانا مرفق ملف فيه المطلوب وتقبلوا فائق الاحترام اليومية الأخيرة.rar
أبو شرف قام بنشر أغسطس 26, 2013 الكاتب قام بنشر أغسطس 26, 2013 اخواني هل من مساعدة قدر الأمكان البرنامج . متوقفين عن العمل بسبب هذه المشكلة وتقبلوا فائق الأحترام والتقدير ابو شرف
عبدالله باقشير قام بنشر أغسطس 26, 2013 قام بنشر أغسطس 26, 2013 السلام عليكم تم تعديل الكود التالي Sub Kh_Start() On Error Resume Next Dim MyRang As Range Dim LastRow As Integer, M As Integer, R As Integer, C As Integer '=========================================== 'عدد صفوف القيد المرحل زايداً فارق الصفوف في الورقةوهي 10 صفوف M = Application.CountA([B11:B39]) + 10 '=========================================== 'تجميع الخلايا الغير منتظمة في نساق واحد Set MyRang = Range("B2,B3,A11,B4,B5,B6,B7") '=========================================== 'اذا كان القيد غير متوازن لا يتم الترحيل If Range("D41").Value = False Then MsgBox "القيد غير متوازن", 524288, "تنبيه": GoTo 1 '=========================================== 'تاكيد الاستمرار في الترحيل If MsgBox("هل تريد الاستمرار في ترحيل القيد رقم : " & [B2], 4 + 32 + 524288 + 1048576, "تأكيد الترحيل") = 7 Then GoTo 1 '=========================================== With ورقة11 '=========================================== 'اذا كانت آخر خلية في العمود الثالث في اليومية التحليلية 'اصغر من 6 يبدا من الصف رقم 6 والا يعتمد آخر صف بزيادة صف واحد If .Cells(5997, 3).End(xlUp).Row < 6 Then LastRow = 6 _ Else LastRow = .Cells(5997, 3).End(xlUp).Row + 1 '=========================================== Application.ScreenUpdating = False For R = 11 To M For C = 1 To 7 .Cells(LastRow, C + 2) = MyRang.Areas(C) Next C If Len(.Cells(LastRow, 10)) Then GoTo 10 If Application.CountA([D11:D39]) > 1 Then .Cells(LastRow, 10) = "مذكورين": GoTo 10 If Val(Cells(R, 4)) Then .Cells(LastRow, 10) = Cells(R, 2) 10 If Len(.Cells(LastRow, 11)) Then GoTo 20 If Application.CountA([E11:E39]) > 1 Then .Cells(LastRow, 11) = "مذكورين": GoTo 20 If Val(Cells(R, 5)) Then .Cells(LastRow, 11) = Cells(R, 2) 20 If Cells(R, 3) <> "" Then .Cells(LastRow, 20) = Cells(R, 3).Value If Cells(R, 4) <> "" Then .Cells(LastRow, Cells(R, 8).Value).Value = Cells(R, 4).Value If Cells(R, 5) <> "" Then .Cells(LastRow, Cells(R, 8).Value + 1).Value = Cells(R, 5).Value Next R End With Application.ScreenUpdating = True MsgBox "تم الترحيل بنجاح", 524288, "الحمد لله" '=========================================== 'امسح الخلايا المنقولة اذا اردت ذلك Range("B2:B6,B7").ClearContents Range("A11:E39").ClearContents '=========================================== On Error GoTo 0 1 End Sub جرب واشعرنا بالنتيجة شاهد الملف 2003 اليومية الأخيرة.rar
عبدالله باقشير قام بنشر أغسطس 26, 2013 قام بنشر أغسطس 26, 2013 السلام عليكم هذا تعديل افضل للكود Sub Kh_Start() On Error Resume Next Dim MyRang As Range Dim LastRow As Integer, M As Integer, R As Integer, C As Integer '=========================================== 'عدد صفوف القيد المرحل زايداً فارق الصفوف في الورقةوهي 10 صفوف M = Application.CountA([B11:B39]) + 10 '=========================================== 'تجميع الخلايا الغير منتظمة في نساق واحد Set MyRang = Range("B2,B3,A11,B4,B5,B6,B7") '=========================================== 'اذا كان القيد غير متوازن لا يتم الترحيل If Range("D41").Value = False Then MsgBox "القيد غير متوازن", 524288, "تنبيه": GoTo 1 '=========================================== 'تاكيد الاستمرار في الترحيل If MsgBox("هل تريد الاستمرار في ترحيل القيد رقم : " & [B2], 4 + 32 + 524288 + 1048576, "تأكيد الترحيل") = 7 Then GoTo 1 '=========================================== With ورقة11 '=========================================== 'اذا كانت آخر خلية في العمود الثالث في اليومية التحليلية 'اصغر من 6 يبدا من الصف رقم 6 والا يعتمد آخر صف بزيادة صف واحد If .Cells(5997, 3).End(xlUp).Row < 6 Then LastRow = 6 _ Else LastRow = .Cells(5997, 3).End(xlUp).Row + 1 '=========================================== Application.ScreenUpdating = False For C = 1 To 7 .Cells(LastRow, C + 2) = MyRang.Areas(C) Next For R = 11 To M If Len(.Cells(LastRow, 10)) Then GoTo 10 If Application.CountA([D11:D39]) > 1 Then .Cells(LastRow, 10) = "مذكورين": GoTo 10 If Val(Cells(R, 4)) Then .Cells(LastRow, 10) = Cells(R, 2) 10 If Len(.Cells(LastRow, 11)) Then GoTo 20 If Application.CountA([E11:E39]) > 1 Then .Cells(LastRow, 11) = "مذكورين": GoTo 20 If Val(Cells(R, 5)) Then .Cells(LastRow, 11) = Cells(R, 2) 20 If Cells(R, 3) <> "" Then .Cells(LastRow, 20) = Cells(R, 3).Value If Cells(R, 4) <> "" Then .Cells(LastRow, Cells(R, 8).Value).Value = Cells(R, 4).Value If Cells(R, 5) <> "" Then .Cells(LastRow, Cells(R, 8).Value + 1).Value = Cells(R, 5).Value Next R End With Application.ScreenUpdating = True MsgBox "تم الترحيل بنجاح", 524288, "الحمد لله" '=========================================== 'امسح الخلايا المنقولة اذا اردت ذلك Range("B2:B6,B7").ClearContents Range("A11:E39").ClearContents '=========================================== On Error GoTo 0 1 End Sub تحياتي
أبو شرف قام بنشر أغسطس 26, 2013 الكاتب قام بنشر أغسطس 26, 2013 (معدل) استاذنا الغالي نشكرك جزيل الشكر ودمت لنا اخ وصديق .......... حفظك الله سسسسسسسسسسوف اجرب العمل على الملف وعطيك النتيجة بأذن الله اخوك ابو شرف تم تعديل أغسطس 26, 2013 بواسطه أبو شرف
أحمد فؤاد قام بنشر أغسطس 26, 2013 قام بنشر أغسطس 26, 2013 السلام عليكم ورحمة الله وبركاته أستاذي / عبد الله باقشير كود رائع بارك الله فيك دائما مبدع وأكوادك تمتاز بالدقة والفنية جعله الله في ميزان حسناتك
الفرس قام بنشر أغسطس 27, 2013 قام بنشر أغسطس 27, 2013 استاذى الكبير / عبدالله باقشير السلام عليكم ....... جزاكم الله خيرا .. ودمت لنا زخرا ومعلما واطال الله عمرك فى الخير انا استخدم هذه اليومية بشكل ممتاز ونتائجها غاية فى الروعة وكم وفرت لى من الوقت والجهد الكثير ولكنى اضطر الى عمل ملف يومية لكل شهر منفصل عن الاخر .. لما تعلمه انه من الممكن اثبات قيود فى اليومية بعد انتهاء الشهر وبعد تسجيل قيود اخرى فى الشهر التالى فلى طلب وهو : عمل يومية واحدة لكل الشهور بحيث تحقق الاتى : 1 - ترحل القيد فى تسلسله التاريخى 2 - عمل مجاميع للشهور سواء فى الاجمالى او الحسابات 3 - لاتأثر هذه المجاميع على ميزان المراجعة فيكون شاملا للسنة كلها واكون لك شاكرا لان ماسبق سيكون قد استوفت اليومية الغرض منها اخوك/ ممدوح محمد الفرس
أبو شرف قام بنشر أغسطس 28, 2013 الكاتب قام بنشر أغسطس 28, 2013 استاذنا الغالي لقد عبر مستوفيا الأخ ممدوح محمد الفرس كل ما يتمناه المحاسب بطلباته حول جل اليومية شاملة لكل السنة ونتمنى ان هذا حقيقة لان الربط بين الأشهر ببعضها هو العمل المحاسبي الوافي وتقبل تقديرنا اخوكم ابو شرف
الفرس قام بنشر أغسطس 29, 2013 قام بنشر أغسطس 29, 2013 علماء هذا المنتدى العظيم استاذى الكبير / عبدالله باقشير السلا م عليكم ورحمة الله وبركاته اعلم ان ماتبذلونه فى ايجاد الحلول لاعضاء المنتدى جهد كبير والجميل فيه هو تطوعا منكم وخالص لوجه الله ولى وطيد امل فى حل مشكلة اليومية العامة حسب المطلوب فى المشاركة السابقة لانها ستستوفى الغرض منها لو تم حلها اخوكم / ممدوح الفرس
الفرس قام بنشر أغسطس 31, 2013 قام بنشر أغسطس 31, 2013 اخوانى الافاضل / علماء المنتدى السلام عليكم ارجو مساعدة اخوانكم المحاسبين فى هذا التعديل البسيط فى اليومية العامة وهو : الترحيل يكون حسب تسلسل التاريخ وتسلسل رقم القيد - وترك اول سطر فى اليومية العامة سيتم تسجيل فيه القيد الافتتاحى لكل شهر يدويا مع خالص الشكر اليومية الأخيرة.rar
عبدالله باقشير قام بنشر أغسطس 31, 2013 قام بنشر أغسطس 31, 2013 استاذى الكبير / عبدالله باقشير السلام عليكم ....... جزاكم الله خيرا .. ودمت لنا زخرا ومعلما واطال الله عمرك فى الخير انا استخدم هذه اليومية بشكل ممتاز ونتائجها غاية فى الروعة وكم وفرت لى من الوقت والجهد الكثير ولكنى اضطر الى عمل ملف يومية لكل شهر منفصل عن الاخر .. لما تعلمه انه من الممكن اثبات قيود فى اليومية بعد انتهاء الشهر وبعد تسجيل قيود اخرى فى الشهر التالى فلى طلب وهو : عمل يومية واحدة لكل الشهور بحيث تحقق الاتى : 1 - ترحل القيد فى تسلسله التاريخى 2 - عمل مجاميع للشهور سواء فى الاجمالى او الحسابات 3 - لاتأثر هذه المجاميع على ميزان المراجعة فيكون شاملا للسنة كلها واكون لك شاكرا لان ماسبق سيكون قد استوفت اليومية الغرض منها اخوك/ ممدوح محمد الفرس وعليكم السلام تم عمل ميزان مراجعة للاشهر ويتم الفرز عند الترحيل حسب تسلسل التاريخ شاهد المرفق 2003 اليومية الأخيرة.rar
الفرس قام بنشر أغسطس 31, 2013 قام بنشر أغسطس 31, 2013 استاذى الحبيب / عبدالله باقشير السلام عليكم ورحمة الله والله .... انى احبك فى الله ... اشكرك على اهتمامك ... اليومية الان ترحل حسب التسلسل التاريخى .. اطمع ايضا ان يكون الترحيل حسب رقم القيد بالاضافة الى التسلسل التاريخ وفى المرفق مثال :( تم ترحيل قيد 4 فى تاريخ 20/1/2013 قبل قيد 3 فى 20/1/2013 ) اليومية الأخيرة.rar
عبدالله باقشير قام بنشر أغسطس 31, 2013 قام بنشر أغسطس 31, 2013 وعليكم السلام جزاكم الله خيرا غير الكود بهذا Sub Kh_Start() On Error Resume Next Dim MyRang As Range Dim LastRow As Integer, M As Integer, R As Integer, C As Integer '=========================================== 'عدد صفوف القيد المرحل زايداً فارق الصفوف في الورقةوهي 10 صفوف M = Application.CountA([B11:B39]) + 10 '=========================================== 'تجميع الخلايا الغير منتظمة في نساق واحد Set MyRang = Range("B2,B3,A11,B4,B5,B6,B7") '=========================================== 'اذا كان القيد غير متوازن لا يتم الترحيل If Range("D41").Value = False Then MsgBox "القيد غير متوازن", 524288, "تنبيه": GoTo 1 '=========================================== 'تاكيد الاستمرار في الترحيل If MsgBox("هل تريد الاستمرار في ترحيل القيد رقم : " & [B2], 4 + 32 + 524288 + 1048576, "تأكيد الترحيل") = 7 Then GoTo 1 '=========================================== With ورقة11 '=========================================== 'اذا كانت آخر خلية في العمود الثالث في اليومية التحليلية 'اصغر من 6 يبدا من الصف رقم 6 والا يعتمد آخر صف بزيادة صف واحد If .Cells(5997, 3).End(xlUp).Row < 6 Then LastRow = 6 _ Else LastRow = .Cells(5997, 3).End(xlUp).Row + 1 '=========================================== Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For C = 1 To 7 .Cells(LastRow, C + 2) = MyRang.Areas(C) Next For R = 11 To M If Len(.Cells(LastRow, 10)) Then GoTo 10 If Application.CountA([D11:D39]) > 1 Then .Cells(LastRow, 10) = "مذكورين": GoTo 10 If Val(Cells(R, 4)) Then .Cells(LastRow, 10) = Cells(R, 2) 10 If Len(.Cells(LastRow, 11)) Then GoTo 20 If Application.CountA([E11:E39]) > 1 Then .Cells(LastRow, 11) = "مذكورين": GoTo 20 If Val(Cells(R, 5)) Then .Cells(LastRow, 11) = Cells(R, 2) 20 If Cells(R, 3) <> "" Then .Cells(LastRow, 20) = Cells(R, 3).Value If Cells(R, 4) <> "" Then .Cells(LastRow, Cells(R, 8).Value).Value = Cells(R, 4).Value If Cells(R, 5) <> "" Then .Cells(LastRow, Cells(R, 8).Value + 1).Value = Cells(R, 5).Value Next R With .Range("C6:CJ5997") .Sort .Columns(2), xlAscending, .Columns(1), , xlAscending End With End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "تم الترحيل بنجاح", 524288, "الحمد لله" '=========================================== 'امسح الخلايا المنقولة اذا اردت ذلك Range("B2:B6,B7").ClearContents Range("A11:E39").ClearContents '=========================================== On Error GoTo 0 1 End Sub تحياتي
الفرس قام بنشر أغسطس 31, 2013 قام بنشر أغسطس 31, 2013 اخى الحبيب .. دمت لنا جميعا معلما ومعينا .. جزاكم الله خيرا هذا هو المطلوب بالضبط
أبو شرف قام بنشر أغسطس 31, 2013 الكاتب قام بنشر أغسطس 31, 2013 مشاء الله يا اخواني على هذه الأنجازات .... ربي يوفقكم وينصركم وان شاء الله دائما في مزيد من التقدم العلمي ونشكر كل من شارك في هذا العمل وجزاكم الله كل خير وشكر خاص لادارة الموقع والى المشرفين والى الأعضاء جميعا تنمنى دائما ان يعم الخير للجميع ويبقى لنا هذا الصرح العظيم نبراسا عظيم اخوكم ابو شرف
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.