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

برنامج محاسبة يومية


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

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

اخواني اعضاء هذاالمنتدى الكرام تحية طيبة 

ارفق لكم نسخة من برنامج محاسبي بسيط وهو يشبه السجل المحاسبي العام 

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

وتقبلوا فائق التقدير 

اخوكم 

ابو شرف

الحسابات.rar

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

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

أهلا"  بكم  في  هذا  المندى  الرائع  ومرحبا"

لو تحاول  تصميم  نموذج لصفحة المستندات  ,, ونموذج  لميزان  المراجعة  الذي  تريده  أنت

يمكن  مساعدتك  ,,,  وعلى  العموم  هناك  مواضيع  كثيرة  ونماذج  كثيرة  في  هذا  المندى   لطلبكم

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

اليومية العامة.rar

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

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

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

وتحملني قليلا . 

اخوكم 

ابو شرف

فقط عني ملاحظة 

ميزان المراجعة يخرج عندي بالارصدة فقط ارجو ان يخرج عندي مجاميع وارصيدة لو بالو بالأمكان مع التقدير 

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

الاخ الكريم ابو شرف

 

السلام غليكم

 

ميزان المراجعة يتم الترحيل من اليومية العامة المجاميع فقط

 

اما الارصدة فيتم تسجيلها من الاساتذة المساعدة

 

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

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

الأخوة الأعزاء الكرام 

هذه مشاركة لاحد الزملاء في المنتدى وقد استفدنا منها جميعا 

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

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

وتقبلوا فائق الاحترام 

 

اليومية الأخيرة.rar

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

السلام عليكم

تم تعديل الكود التالي

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

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

السلام عليكم

هذا تعديل افضل للكود

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

تحياتي

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

استاذنا الغالي نشكرك جزيل الشكر ودمت لنا اخ وصديق .......... حفظك الله 

سسسسسسسسسسوف اجرب العمل على الملف وعطيك النتيجة بأذن الله 

اخوك 

 ابو شرف 

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

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

أستاذي / عبد الله باقشير

كود رائع بارك الله فيك دائما مبدع وأكوادك تمتاز بالدقة والفنية

جعله الله في ميزان حسناتك

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

استاذى الكبير / عبدالله باقشير

 

السلام عليكم ....... جزاكم الله خيرا .. ودمت لنا زخرا ومعلما واطال الله عمرك فى الخير

 

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

 

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

 

وبعد تسجيل قيود اخرى فى الشهر التالى

 

فلى طلب وهو : عمل يومية واحدة لكل الشهور بحيث تحقق الاتى :

1 - ترحل القيد فى تسلسله التاريخى

2 - عمل مجاميع للشهور سواء فى الاجمالى او الحسابات

3 - لاتأثر هذه المجاميع على ميزان المراجعة فيكون شاملا للسنة كلها

 

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

 

اخوك/  ممدوح محمد الفرس

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

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

وتقبل تقديرنا 

اخوكم 

ابو شرف 

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

علماء هذا  المنتدى  العظيم

 

استاذى الكبير / عبدالله باقشير

 

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

 

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

 

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

 

اخوكم / ممدوح الفرس

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

اخوانى الافاضل / علماء المنتدى

 

السلام عليكم

 

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

 

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

 

مع خالص الشكر

 

اليومية الأخيرة.rar

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

استاذى الكبير / عبدالله باقشير

 

السلام عليكم ....... جزاكم الله خيرا .. ودمت لنا زخرا ومعلما واطال الله عمرك فى الخير

 

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

 

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

 

وبعد تسجيل قيود اخرى فى الشهر التالى

 

فلى طلب وهو : عمل يومية واحدة لكل الشهور بحيث تحقق الاتى :

1 - ترحل القيد فى تسلسله التاريخى

2 - عمل مجاميع للشهور سواء فى الاجمالى او الحسابات

3 - لاتأثر هذه المجاميع على ميزان المراجعة فيكون شاملا للسنة كلها

 

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

 

اخوك/  ممدوح محمد الفرس

وعليكم السلام

 

تم عمل ميزان مراجعة للاشهر

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

 

شاهد المرفق 2003

اليومية الأخيرة.rar

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

استاذى الحبيب / عبدالله باقشير

 

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

 

والله .... انى احبك فى الله  ... 

 

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

 

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

 

وفى المرفق مثال :( تم ترحيل قيد 4 فى تاريخ 20/1/2013 قبل قيد 3 فى 20/1/2013 )

 

اليومية الأخيرة.rar

 

 

 

 

 

 

 

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

وعليكم السلام

 

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

 

غير الكود بهذا

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

تحياتي

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

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

ونشكر كل من شارك في هذا العمل وجزاكم الله كل خير 

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

اخوكم 

ابو شرف 

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

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