إمتداد لإضافة ورقة للقيود مع بعض التعديل&#1575

**طارق محمود** · مارس 25, 2010


الرابعة:


الكود يرحل ولو من غير قيمة في المدين أو الدائن... هل من حل؟

إن شاء الله يوجد حل: في أول كود القيد الذي أرسلته أنت

Sub QID()

Dim xxx As String



S_NAME1 = Range("C6").Value

S_NAME2 = Range("C7").Value

s_Acc1 = Range("B6").Value

s_Acc2 = Range("B7").Value

s_explain = Range("f6").Value '=== ===

S_explain2 = Range("F7").Value '=== 	===

s_kind = Range("E2").Value 	'=== ¡ 	===

S_AMOUNT1 = Range("D6").Value	'=== =====

S_AMOUNT2 = Range("E6").Value	'=== =====

فما عليك إلا أن تضيف الشرطين التاليين مباشرة بعد هذه الأسطر


If S_AMOUNT1 = 0 And S_AMOUNT2 = 0 Then Exit Sub ' Case 1 both = zero

If S_AMOUNT1 > 0 And S_AMOUNT2 > 0 Then Exit Sub ' Case 2 both > zero

أول شرط إذا كانا كلا من الدائن والمدين أصفارا يعني بلا قيمة ، فسيخرج من البرنامج ولن يرحل

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

**طارق محمود** · مارس 25, 2010

يا سبحان الله .. كم هو شيق هذا العلم...

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

Worksheets(S_NAME1).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = S_AMOUNT1

ActiveCell.Offset(0, 2).Value = S_AMOUNT2

لم أفهم سؤالك هذا

أرجو إعادة صياغته

onlymanly · مارس 25, 2010

بارك الله فيك استاذي طارق...

اقصد كيف أدخل S_AMOUNT1 حتى S_AMOUNT40 في الموقع أدناه؟ مع رمز اختصارك الذي كتبته لي امس؟

ActiveCell.Offset(0, 1).Value = S_AMOUNT1

ActiveCell.Offset(0, 2).Value = S_AMOUNT2

**طارق محمود** · مارس 25, 2010

أولا كما إتفقنا هذا السطر في أول الكود


Dim s_amount(99) As Variant

ولابد أن يكون إدخال البيانات لهذه المتغيرات بصورة المصفوفة أي

s_amount (1)

بدلا من

s_amount1

ثم هذ الأسطر


For i = 1 To 40

 	ActiveCell.Offset(0, i).Value = s_amount(i)

Next i

For i = 1 To 40

ActiveCell.Offset(0, i).Value = s_amount(i)

Next i

onlymanly · مارس 25, 2010

عند مجلد إسمه

الملف الذي منه يتم الترحيل في الدليل

DK

DK\ACCOUNTS\DATA\2.XLS و هو التي تترحل إليه الحسابات

هنا دليل ترحيل نسخ من الفواتير

DK\ACCOUNTS\ARCHIVES\INVOICE\INVOICE.XLS

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

DK\ACCOUNTS\ARCHIVES\INVOICE\PACKINGLIST.XLS

هنا دليل ترحيل نسخ من سندات القبض كأرشفة

DK\ACCOUNTS\ARCHIVES\QS\قبض.XLS

هنا دليل ترحيل نسخ من سندات الصرف كأرشفة

DK\ACCOUNTS\ARCHIVES\QS\صرف.XLS

فكيف أكتبها داخل المايكرو؟

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

تم تعديل مارس 25, 2010 بواسطه onlymanly

**طارق محمود** · مارس 25, 2010

مبدئيا

لابد ان تكتب المسار كاملا في كل ماذكرت ،

لابد أن تذكر أولا ماقبل الــ DK وتصل بها إلي أحد أجزاء الهارد ديسك

C:\

أو

D:\

مثلا

code]<br>C:\xxxx\yyyy\DK\ACCOUNTS\...

أو

D:\xxxx\yyyy\DK\ACCOUNTS\...

تم تعديل مارس 25, 2010 بواسطه TareQ M

**طارق محمود** · مارس 25, 2010

بعض النصائح بخصوص فتح الملف وإغلاقه والكتابة فيه

1. أولا تراجع إذا كان الملف مفتوح وإلا يفتحه

2. تضع إسم الملف مع مساره في متغير يمكنك من فهمه مستقبلا

مثلا

بيان التعبئة
DK\ACCOUNTS\ARCHIVES\INVOICE\PACKINGLIST.XLS

يمكنك إضافة متغير PACK_LIST

هكذا

PACK_LIST = "D:\xxxx\yyyy\DK\ACCOUNTS\ARCHIVES\INVOICE\PACKINGLIST.XLS"

ثم تطلب فتحه هكذا


Workbooks.Open PACK_LIST

أو تنشطه لإستقبال الترحيل أو أخذ البيانات هكذا

Windows(PACK_LIST).Activate

onlymanly · مارس 25, 2010

الصراحة لم اهتد لجعل الملف يرحل نسخة إلى الدليل التالي:

D:\Only\ACCOUNTS\ARCHIVES\QS\قبض.xls

و هذا موضع الكود الذي يطلب الدليل:

a = Workbooks.Count

x = "Close"

For i = 1 To a

If Workbooks(i).Name = "ÞÈÖ.xls" Then x = "OPEN"

Next i

If x = "Close" Then xxx = ActiveWorkbook.Path & "\" & "ÞÈÖ.xls": Workbooks.Open xxx

Windows("ÞÈÖ.xls").Activate

x = Worksheets.Count

For i = 1 To x

If Worksheets(i).Name = S_NAME1 Then GoTo 300

Next i

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = S_NAMESANAD

Range("I3").Value = S_NAMESANAD

300

Range("a1000").Select

Selection.End(xlUp).Select

ActiveCell.Offset(7, 4).Value = S_AMOUNT

ActiveCell.Offset(4, 6).Value = S_ACC1

ActiveCell.Offset(11, 6).Value = S_ACC2

ActiveCell.Offset(11, 9).Value = S_DATE

ActiveCell.Offset(4, 4).Value = S_NAME1

ActiveCell.Offset(11, 4).Value = S_NAME2

ActiveCell.Offset(9, 4).Value = S_DUL

ActiveCell.Offset(9, 10).Value = S_difference_DUL

ActiveCell.Offset(9, 12).Value = S_difference_Y

ActiveCell.Offset(9, 6).Value = S_SARF

Windows("ÞÈÖ.xls").Activate

ActiveWorkbook.Close SaveChanges:=True

onlymanly · مارس 25, 2010

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

تم تعديل مارس 25, 2010 بواسطه onlymanly

onlymanly · مارس 25, 2010

كيف أختصر كل هذا؟ :)

'S_ACC1 = Range("IU5").Value

'S_ACC2 = Range("IU6").Value

'S_ACC3 = Range("IU7").Value

'S_ACC4 = Range("IU8").Value

'S_ACC5 = Range("IU9").Value

'S_ACC6 = Range("IU10").Value

'S_ACC7 = Range("IU11").Value

'S_ACC8 = Range("IU12").Value

'S_ACC9 = Range("IU13").Value

'S_ACC10 = Range("IU14").Value

'S_ACC11 = Range("IU15").Value

'S_ACC12 = Range("IU16").Value

'S_ACC13 = Range("IU17").Value

'S_ACC14 = Range("IU18").Value

'S_ACC15 = Range("IU19").Value

'S_ACC16 = Range("IU20").Value

'S_ACC17 = Range("IU21").Value

'S_ACC18 = Range("IU22").Value

'S_ACC19 = Range("IU23").Value

'S_ACC20 = Range("IU24").Value

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

For i = 1 To 20

s_amount(i * 2 - 1) = Range("C" & i + 4).Value مثل هذا ؟؟؟

s_amount(i * 2) = Range("D" & i + 4).Value

Next i

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

S_explain1 = Range("E5").Value

S_explain2 = Range("E6").Value

S_explain3 = Range("E7").Value

S_explain4 = Range("E8").Value

S_explain5 = Range("E9").Value

S_explain6 = Range("E10").Value

S_explain7 = Range("E11").Value

S_explain8 = Range("E12").Value

S_explain9 = Range("E13").Value

S_explain10 = Range("E14").Value

S_explain11 = Range("E15").Value

S_explain12 = Range("E16").Value

S_explain13 = Range("E17").Value

S_explain14 = Range("E18").Value

S_explain15 = Range("E19").Value

S_explain16 = Range("E20").Value

S_explain17 = Range("E21").Value

S_explain18 = Range("E22").Value

S_explain19 = Range("E23").Value

S_explain20 = Range("E24").Value

ياريت تعلمني كيف اصطاد السمك ... لم أفهم الكود الذي اختصر لي ال S_ACOUNT و فعلا كان جميل جدا

**طارق محمود** · مارس 25, 2010

السلام عليكم

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

وكذلك العلاقة بين الرقم في يمين ويسار المعادلة أنه بفارق 4 دائما

وهكذا

مثلا

S_ACC1 = Range("IU5").Value

أو

S_explain1 = Range("E5").Value

وعلي ذلك تكون الأكواد كالتالي

For i = 1 To 20

S_ACC(i) = Range("IU" & i + 4).Value

Next i

For i = 1 To 20

S_explain(i) = Range("E" & i + 4).Value

Next i

onlymanly · مارس 25, 2010

اسعد الله صباحك مولانا ..

استفدت كثيرا من هذا المنتدى و منك بالذات فجزاك الله خيرا...

اسمح لي أن أطرح بعض التساؤلات:

أولا: في القيود: الكود التالي:

Sub QID()

Dim xxx As String

S_NAMESANAD = Range("E2").Value

'______________________________________________

Range("IV1").Value = Range("IV1").Value + 1

' '______________________________________________

S_KIND = "QAID"

S_SER = Range("E2").Value

S_DATE = Range("B3").Value

'______________________________________________

Dim s_name(99) As Variant

For I = 1 To 20

s_name(I) = Range("B" & I + 4).Value

Next I

'______________________________________________

Dim S_ACC(99) As Variant

For I = 1 To 20

S_ACC(I) = Range("IU" & I + 4).Value

Next I

'______________________________________________

Dim s_amount(99) As Variant

For I = 1 To 20

s_amount(I * 2 - 1) = Range("C" & I + 4).Value

s_amount(I * 2) = Range("D" & I + 4).Value

Next I

'______________________________________________

Dim S_explain(99) As Variant

For I = 1 To 20

S_explain(I) = Range("E" & I + 4).Value

Next I

'______________________________________________

A = Workbooks.Count

X = "Close"

For I = 1 To A

If Workbooks(I).Name = "2.xls" Then X = "OPEN"

Next I

If X = "Close" Then xxx = ActiveWorkbook.Path & "\" & "2.xls": Workbooks.Open xxx

Windows("2.xls").Activate

'______________________________________________

'ACC(1)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(1) Then GoTo 100

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(1)

Range("C1").Value = S_ACC(1)

Range("F3").Value = s_name(1)

100

Worksheets(s_name(1)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(1)

ActiveCell.Offset(0, 2).Value = s_amount(2)

ActiveCell.Offset(0, 5).Value = S_explain(1)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(2)

'______________________________________________

'ACC(2)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(2) Then GoTo 200

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(2)

Range("C1").Value = S_ACC(2)

Range("F3").Value = s_name(2)

200

Worksheets(s_name(2)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(3)

ActiveCell.Offset(0, 2).Value = s_amount(4)

ActiveCell.Offset(0, 5).Value = S_explain(2)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(1)

'______________________________________________

'ACC(3)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(3) Then GoTo 300

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(3)

Range("C1").Value = S_ACC(3)

Range("F3").Value = s_name(3)

300

Worksheets(s_name(3)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(5)

ActiveCell.Offset(0, 2).Value = s_amount(6)

ActiveCell.Offset(0, 5).Value = S_explain(3)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(4)

'______________________________________________

'ACC(4)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(4) Then GoTo 400

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(4)

Range("C1").Value = S_ACC(4)

Range("F3").Value = s_name(4)

400

Worksheets(s_name(4)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(7)

ActiveCell.Offset(0, 2).Value = s_amount(8)

ActiveCell.Offset(0, 5).Value = S_explain(4)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(3)

'______________________________________________

'ACC(5)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(5) Then GoTo 500

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(5)

Range("C1").Value = S_ACC(5)

Range("F3").Value = s_name(5)

500

Worksheets(s_name(5)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(9)

ActiveCell.Offset(0, 2).Value = s_amount(10)

ActiveCell.Offset(0, 5).Value = S_explain(5)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(6)

'______________________________________________

'ACC(6)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(6) Then GoTo 600

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(6)

Range("C1").Value = S_ACC(6)

Range("F3").Value = s_name(6)

600

Worksheets(s_name(6)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(11)

ActiveCell.Offset(0, 2).Value = s_amount(12)

ActiveCell.Offset(0, 5).Value = S_explain(6)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(5)

'______________________________________________

'ACC(7)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(7) Then GoTo 700

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(7)

Range("C1").Value = S_ACC(7)

Range("F3").Value = s_name(7)

700

Worksheets(s_name(7)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(13)

ActiveCell.Offset(0, 2).Value = s_amount(14)

ActiveCell.Offset(0, 5).Value = S_explain(7)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(8)

'______________________________________________

'ACC(8)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(8) Then GoTo 800

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(8)

Range("C1").Value = S_ACC(8)

Range("F3").Value = s_name(8)

800

Worksheets(s_name(8)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(15)

ActiveCell.Offset(0, 2).Value = s_amount(16)

ActiveCell.Offset(0, 5).Value = S_explain(8)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(7)

'______________________________________________

'ACC(9)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(9) Then GoTo 900

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(9)

Range("C1").Value = S_ACC(9)

Range("F3").Value = s_name(9)

900

Worksheets(s_name(9)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(17)

ActiveCell.Offset(0, 2).Value = s_amount(18)

ActiveCell.Offset(0, 5).Value = S_explain(9)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(10)

'______________________________________________

'ACC(10)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(10) Then GoTo 1000

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(10)

Range("C1").Value = S_ACC(10)

Range("F3").Value = s_name(10)

1000

Worksheets(s_name(10)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(19)

ActiveCell.Offset(0, 2).Value = s_amount(20)

ActiveCell.Offset(0, 5).Value = S_explain(10)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(9)

'______________________________________________

'ACC(11)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(11) Then GoTo 1010

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(11)

Range("C1").Value = S_ACC(11)

Range("F3").Value = s_name(11)

1010

Worksheets(s_name(11)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(21)

ActiveCell.Offset(0, 2).Value = s_amount(22)

ActiveCell.Offset(0, 5).Value = S_explain(11)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(12)

'______________________________________________

'ACC(12)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(12) Then GoTo 1100

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(12)

Range("C1").Value = S_ACC(12)

Range("F3").Value = s_name(12)

1100

Worksheets(s_name(12)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(23)

ActiveCell.Offset(0, 2).Value = s_amount(24)

ActiveCell.Offset(0, 5).Value = S_explain(12)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(11)

'______________________________________________

'ACC(13)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(13) Then GoTo 1150

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(13)

Range("C1").Value = S_ACC(13)

Range("F3").Value = s_name(13)

1150

Worksheets(s_name(13)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(25)

ActiveCell.Offset(0, 2).Value = s_amount(26)

ActiveCell.Offset(0, 5).Value = S_explain(13)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(14)

'______________________________________________

'ACC(14)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(14) Then GoTo 1200

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(14)

Range("C1").Value = S_ACC(14)

Range("F3").Value = s_name(14)

1200

Worksheets(s_name(14)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(27)

ActiveCell.Offset(0, 2).Value = s_amount(28)

ActiveCell.Offset(0, 5).Value = S_explain(14)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(13)

'______________________________________________

'ACC(15)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(15) Then GoTo 1250

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(15)

Range("C1").Value = S_ACC(15)

Range("F3").Value = s_name(15)

1250

Worksheets(s_name(15)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(29)

ActiveCell.Offset(0, 2).Value = s_amount(30)

ActiveCell.Offset(0, 5).Value = S_explain(15)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(16)

'______________________________________________

'ACC(16)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(16) Then GoTo 1300

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(16)

Range("C1").Value = S_ACC(16)

Range("F3").Value = s_name(16)

1300

Worksheets(s_name(16)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(31)

ActiveCell.Offset(0, 2).Value = s_amount(32)

ActiveCell.Offset(0, 5).Value = S_explain(16)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(15)

'______________________________________________

'ACC(17)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(17) Then GoTo 1380

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(17)

Range("C1").Value = S_ACC(17)

Range("F3").Value = s_name(17)

1380

Worksheets(s_name(17)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(33)

ActiveCell.Offset(0, 2).Value = s_amount(34)

ActiveCell.Offset(0, 5).Value = S_explain(17)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(18)

'______________________________________________

'ACC(18)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(18) Then GoTo 1400

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(18)

Range("C1").Value = S_ACC(18)

Range("F3").Value = s_name(18)

1400

Worksheets(s_name(18)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(35)

ActiveCell.Offset(0, 2).Value = s_amount(36)

ActiveCell.Offset(0, 5).Value = S_explain(18)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(17)

'______________________________________________

'ACC(19)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(19) Then GoTo 1450

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(19)

Range("C1").Value = S_ACC(19)

Range("F3").Value = s_name(19)

1450

Worksheets(s_name(19)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(37)

ActiveCell.Offset(0, 2).Value = s_amount(38)

ActiveCell.Offset(0, 5).Value = S_explain(19)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(20)

'______________________________________________

'ACC(20)

X = Worksheets.Count

For I = 1 To X

If Worksheets(I).Name = s_name(20) Then GoTo 1480

Next I

Sheets("sample").Select

Sheets("sample").Copy Before:=Sheets(1)

ActiveSheet.Name = s_name(20)

Range("C1").Value = S_ACC(20)

Range("F3").Value = s_name(20)

1480

Worksheets(s_name(20)).Select

Range("a1000").Select

Selection.End(xlUp).Select

If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

ActiveCell.Offset(1, 0).Select

ActiveCell.Value = ser

ActiveCell.Offset(0, 1).Value = s_amount(39)

ActiveCell.Offset(0, 2).Value = s_amount(40)

ActiveCell.Offset(0, 5).Value = S_explain(20)

ActiveCell.Offset(0, 6).Value = S_DATE

ActiveCell.Offset(0, 7).Value = S_KIND

ActiveCell.Offset(0, 8).Value = S_SER

ActiveCell.Offset(0, 9).Value = s_name(19)

'________________________________________

Windows("1.xls").Activate

Range("A1").Select

End Sub

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

تم ادخال 20 حساب يتم الترحيل إليهم.

و أترك التساؤات الأخرى.. بعد التخلص من هذه المشكلة

**طارق محمود** · مارس 26, 2010

السلام عليكم

أولا ممكن تغيير رقم الــ 20 الموجود في أول كل Loop مثل

For I = 1 To 20

بأن تسبق ذلك بخطوة إستكشاف لعدد القيود الجاهزة للترحيل بملاحظة أن القيد لابد أن يكون فيه إسم ما في العمود B بداية من الخلية B5 ممكن مثلا تضيف الأمر التالي لتسجيل عدد القيود الجاهزة

Qaid_No = WorksheetFunction.CountA("B5:B1000")

ثم تستبدل كل رقم 20 موجود في أول كل Loop إلي Qaid_No كالتالي

For I = 1 To Qaid_No

ينتج عن هذا أن يعد أولا القيود الموجودة فعلا فيتغير برنامج القراءة في أول الكود إلي قراءة هذا العدد فقط وليس الــ 20

**طارق محمود** · مارس 26, 2010

ثانيا إلغي كل الأكواد المتكررة من 1 إلي 20 (إلغيها كلها) ثم إستبدلها بالكود التالي

'ACC(1 To Qaid_No)


For qq = 1 To Qaid_No

	X = Worksheets.Count

 	For I = 1 To X

 	If Worksheets(I).Name = s_name(qq) Then GoSub 3333

 	Next I

	Sheets("sample").Select

	Sheets("sample").Copy Before:=Sheets(1)

	ActiveSheet.Name = s_name(qq)

	Range("C1").Value = S_ACC(qq)

	Range("F3").Value = s_name(qq)

Next qq



3333

	Worksheets(s_name(qq)).Select

	Range("a1000").Select

	Selection.End(xlUp).Select

 	If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

	ActiveCell.Offset(1, 0).Select

	ActiveCell.Value = ser

	ActiveCell.Offset(0, 1).Value = s_amount(qq * 2 - 1)

	ActiveCell.Offset(0, 2).Value = s_amount(qq * 2)

	ActiveCell.Offset(0, 5).Value = S_explain(qq)

	ActiveCell.Offset(0, 6).Value = S_DATE

	ActiveCell.Offset(0, 7).Value = S_KIND

	ActiveCell.Offset(0, 8).Value = S_SER

 	If WorksheetFunction.MOD(qq, 2) = 1 Then qid_f = 1 Else qid_f = -1

	ActiveCell.Offset(0, 9).Value = s_name(qq + qid_f)

Return

والله الموفق

تم تعديل مارس 26, 2010 بواسطه TareQ M

**طارق محمود** · مارس 26, 2010

أخيرا يكون الكود إجمالا كالتالي


Sub QID()

Dim s_name(99), S_ACC(99), s_amount(99), S_explain(99) As Variant, xxx As String

S_NAMESANAD = Range("E2").Value

'______________________________________________

Qaid_No = WorksheetFunction.CountA("B5:B1000")

'______________________________________________

Range("IV1").Value = Range("IV1").Value + 1

S_KIND = "QAID"

S_SER = Range("E2").Value

S_DATE = Range("B3").Value

'______________________________________________

For I = 1 To Qaid_No

	s_name(I) = Range("B" & I + 4).Value

	S_ACC(I) = Range("IU" & I + 4).Value

	s_amount(I * 2 - 1) = Range("C" & I + 4).Value

	s_amount(I * 2) = Range("D" & I + 4).Value

	S_explain(I) = Range("E" & I + 4).Value

Next I

'______________________________________________

A = Workbooks.Count

X = "Close"


For I = 1 To A

	If Workbooks(I).Name = "2.xls" Then X = "OPEN"

Next I

	If X = "Close" Then xxx = ActiveWorkbook.Path & "\" & "2.xls": Workbooks.Open xxx

Windows("2.xls").Activate

'______________________________________________

'ACC(1 To Qaid_No)


For qq = 1 To Qaid_No

	X = Worksheets.Count

	For I = 1 To X

 	If Worksheets(I).Name = s_name(qq) Then GoSub 3333

	Next I

	Sheets("sample").Select

	Sheets("sample").Copy Before:=Sheets(1)

	ActiveSheet.Name = s_name(qq)

	Range("C1").Value = S_ACC(qq)

	Range("F3").Value = s_name(qq)

Next qq

'______________________________________________

3333

	Worksheets(s_name(qq)).Select

	Range("a1000").Select

	Selection.End(xlUp).Select

 	If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

	ActiveCell.Offset(1, 0).Select

	ActiveCell.Value = ser

	ActiveCell.Offset(0, 1).Value = s_amount(qq * 2 - 1)

	ActiveCell.Offset(0, 2).Value = s_amount(qq * 2)

	ActiveCell.Offset(0, 5).Value = S_explain(qq)

	ActiveCell.Offset(0, 6).Value = S_DATE

	ActiveCell.Offset(0, 7).Value = S_KIND

	ActiveCell.Offset(0, 8).Value = S_SER

 	If WorksheetFunction.MOD(qq, 2) = 1 Then qid_f = 1 Else qid_f = -1

	ActiveCell.Offset(0, 9).Value = s_name(qq + qid_f)

Return

'______________________________________________


Windows("1.xls").Activate

Range("A1").Select

End Sub

onlymanly · مارس 26, 2010

سبحان الله ما أروع هذه الطلاسم :)

اختصار رهيب ..

لكن استاذ طارق.. المف يقف عند النقطة التي ستراها في الصورة

طبعا بعدين عدلت :

If WorksheetFunction.Mod(qq, 2) = "" Then qaid_f = 1 Else qaid_f = -2

بإضفة حرف (e)إلى :

If WorksheetFunction.Mode(qq, 2) = "" Then qaid_f = 1 Else qaid_f = -2

و كذلك غلط يقول: أن WorksheetFunction.Mode من الفئة لا يمكن الحصول ع الخاصية

تم تعديل مارس 26, 2010 بواسطه onlymanly

**طارق محمود** · مارس 27, 2010

أخي العزيز

أرجو إرسال الملف بآخر تعديلات مع إزالة العربي من الأكواد

onlymanly · مارس 27, 2010

أخي العزيز

أرجو إرسال الملف بآخر تعديلات مع إزالة العربي من الأكواد

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

on.rar

تم تعديل مارس 27, 2010 بواسطه onlymanly

onlymanly · مارس 27, 2010

أستاذ طارق عن إذنك سأضيفك في ماسنجري ..

**طارق محمود** · مارس 28, 2010

أستاذ طارق عن إذنك سأضيفك في ماسنجري ..

طبعا، أنا أتشرف بذلك مااسم اليوزر تبعك في الماسنجر onlymanly أم إسم آخر بالمناسبة أنا قليل جدا في إستخدام الماسنجر

**طارق محمود** · مارس 28, 2010

أخي العزيز

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

كان هناك أخطاء صغييييرة للغاية

صلحتها ومرفق الملف 1 فقط (اللي به الماكرو)

تفضل

1.rar

onlymanly · مارس 29, 2010

تعتبك معاي استاذ طارق..

للاسف ظهرت مشكلة أخرى عند الترحيل:)

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

ما عدى الإسم ورقم الحساب فقط لا غير..

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

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

P.rar

**طارق محمود** · مارس 29, 2010

السلام عليكم

أنا أيضا تعبتك لأني غير محترف فقط أعلم في هذا الباب أكثر منك قليلا

إستبدل الكود من عند السطرين التاليين

'ACC(1 To Qaid_No)


For qq = 1 To Qaid_No

إلغيهما مع كل ماأسفلهما إلي نهاية الكود وإستبدل بالتالي وإن شاء الله يضبط معاك '

ACC(1 To Qaid_No)


For qq = 1 To Qaid_No

	X = Worksheets.Count

	For I = 1 To X

	If Worksheets(I).Name = s_name(qq) Then GoSub 3333

	Next I

	chk_all = s_amount(qq * 2 - 1) + s_amount(qq * 2)

	If chk_all = 0 Then GoTo 1000


	Sheets("sample").Select

	Sheets("sample").Copy Before:=Sheets(1)

	ActiveSheet.Name = s_name(qq)

	Range("C1").Value = S_ACC(qq)

	Range("F3").Value = s_name(qq)

'______________________________________________

3333

	Worksheets(s_name(qq)).Select

	Range("a1000").Select

	Selection.End(xlUp).Select

	If ActiveCell.Row = 5 Then ser = 1 Else ser = ActiveCell.Value + 1

	ActiveCell.Offset(1, 0).Select

	ActiveCell.Value = ser

	ActiveCell.Offset(0, 1).Value = s_amount(qq * 2 - 1)

	ActiveCell.Offset(0, 2).Value = s_amount(qq * 2)

	ActiveCell.Offset(0, 5).Value = S_explain(qq)

	ActiveCell.Offset(0, 6).Value = S_DATE

	ActiveCell.Offset(0, 7).Value = S_KIND

	ActiveCell.Offset(0, 8).Value = S_SER

	If (qq / 2 - Int(qq / 2)) = 0.5 Then qid_f = 1 Else qid_f = -1

	ActiveCell.Offset(0, 9).Value = s_name(qq + qid_f)

Return

'______________________________________________


10000


Next qq


Windows("1.xls").Activate

Range("A1").Select

End Sub

تم تعديل مارس 29, 2010 بواسطه TareQ M

onlymanly · مارس 29, 2010

ولا عيب فيهم غير أن سيوفهم............ بهن فلولٌ من قراع الكتائب

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

طارق.... التعديل ضبط معي 100%

**طارق محمود** · مارس 29, 2010

الموضوع ده يشبه ولادة متعسرة

لكن الحمد لله ، تمت عل خير

تسجيل الدخول

إمتداد لإضافة ورقة للقيود مع بعض التعديل&#1575

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

طارق محمود

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

طارق محمود

onlymanly

طارق محمود

onlymanly

طارق محمود

طارق محمود

onlymanly

onlymanly

onlymanly

طارق محمود

onlymanly

طارق محمود

طارق محمود

طارق محمود

onlymanly

طارق محمود

onlymanly

onlymanly

طارق محمود

طارق محمود

onlymanly

طارق محمود

onlymanly

طارق محمود

Join the conversation

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

تصفح الموقع

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

Support

Important Information