النائف

هذا كود يقوم بنسخ من جدول الى جدول بشروط معينه عدد السجلات الناتج عن هذا كبير كيف يمكن عمل نافذة توضح حال التنفيذ Public Sub CreateFile() v_HEAD = "H0122006122400001TESTIPO" v_SUBSCRIPTION_DATE = "20061424" v_RECEIVER_ID = "014" v_CHANNEL_ID = "00024" v_CHEQUE_NUMBER = " " v_CREATION_TS = "20061224193600" v_PORTFOLIO_NUMBER = "14" v_app = 24000001 v_id = 104000001 v_dep = 144000001 DoCmd.RunSQL ("DELETE * FROM FORMATED") Dim S, S2, S3, S4, S5, D1 As String Dim v_count, v_shar, v_value As Double Dim db As Database Dim Rec_from, Rec_to As Recordset Dim dat(49) As String S1 = "" S2 = "" S3 = "" S4 = "" S5 = "" D1 = "" Set db = CurrentDb() Set Rec_to = db.OpenRecordset("FORMATED") Rec_to.AddNew Rec_to!FORMATED_LINE = v_HEAD Rec_to.Update For t = 1 To 25 Set Rec_from = db.OpenRecordset("SELECT * FROM xxxHDR ", dbOpenDynaset, dbReadOnly) Rec_from.MoveFirst Do While Rec_from.EOF <> True v_app = v_app + 1 v_id = v_id + 1 For i = 1 To 46 If IsNull(Rec_from(i)) Then dat(i - 1) = " " Else dat(i - 1) = Rec_from(i) End If Next i dat(3) = Mid(GenSubNo(Str(v_app)), 1, 9) dat(13) = Mid(Get_ID(Str(v_id)), 1, 10) v_ran = Int((20 * Rnd) + 1) * 10 S1 = FillTxt(dat(0), " ", 1, "R") & FillTxt(dat(1), " ", 1, "R") & FillTxt(dat(2), " ", 12, "R") & FillTxt(dat(3), "0", 10, "L") & FillTxt(v_SUBSCRIPTION_DATE, " ", 8, "R") & FillTxt(v_RECEIVER_ID, "0", 3, "L") & FillTxt(v_CHANNEL_ID, "0", 5, "L") & FillTxt(dat(7), " ", 40, "R") & FillTxt(dat(8), " ", 40, "R") & FillTxt(dat(9), " ", 40, "R") & FillTxt(dat(10), " ", 40, "R") S2 = FillTxt(dat(11), " ", 40, "R") & FillTxt(dat(12), " ", 1, "R") & FillTxt(dat(13), " ", 15, "R") & FillTxt(dat(14), " ", 1, "R") & FillTxt(dat(15), " ", 1, "R") & FillTxt(dat(16), " ", 8, "R") & FillTxt(dat(17), " ", 25, "R") & FillTxt(dat(18), " ", 1, "R") & FillTxt(dat(19), " ", 10, "R") & FillTxt(dat(20), " ", 40, "R") S3 = FillTxt(dat(21), " ", 25, "R") & FillTxt(dat(22), " ", 2, "R") & FillTxt(dat(23), " ", 10, "R") & FillTxt(dat(24), " ", 20, "R") & FillTxt(dat(25), " ", 20, "R") & FillTxt(dat(26), "0", 3, "L") & FillTxt(v_ran, "0", 10, "L") & FillTxt((v_ran * Val(dat(26))), "0", 10, "L") & FillTxt((v_ran * Val(dat(26))) * 10, "0", 13, "L") & FillTxt(dat(30), " ", 1, "R") S4 = FillTxt(v_CHEQUE_NUMBER, " ", 10, "L") & FillTxt(dat(32), "0", 20, "L") & FillTxt(dat(33), " ", 40, "R") & FillTxt(dat(34), " ", 15, "R") & FillTxt(dat(35), " ", 1, "R") & FillTxt(dat(36), " ", 40, "R") & FillTxt(dat(37), " ", 10, "R") & FillTxt(dat(38), " ", 25, "R") & FillTxt(dat(39), " ", 2, "R") & FillTxt(dat(40), " ", 10, "R") S5 = FillTxt(dat(41), " ", 20, "R") & FillTxt(dat(42), " ", 20, "R") & FillTxt(dat(43), " ", 10, "R") & FillTxt(v_CREATION_TS, " ", 14, "R") & FillTxt(v_PORTFOLIO_NUMBER, "0", 10, "L") If Val(dat(26)) > 1 Then D1 = "" Set Rec_dep = db.OpenRecordset("SELECT * FROM xxxDTL WHERE SUBSCRIBER_POI ='" & Rec_from.SUBSCRIBER_POI & "'", dbOpenDynaset, dbReadOnly) Rec_dep.MoveFirst Do While Rec_dep.EOF <> True v_dep = v_dep + 1 v_deps = Mid(Get_ID(Str(v_dep)), 1, 9) D1 = D1 & FillTxt(v_deps, " ", 15, "R") & FillTxt(Rec_dep(2), " ", 40, "R") & FillTxt(Rec_dep(3), " ", 1, "R") Rec_dep.MoveNext Loop Rec_dep.Close Else D1 = "" End If Rec_to.AddNew Rec_to!FORMATED_LINE = S1 + S2 + S3 + S4 + S5 + D1 Rec_to.Update v_count = v_count + 1 v_shar = v_shar + v_ran * Val(dat(26)) v_value = v_value + v_ran * Val(dat(26)) * 10 Rec_from.MoveNext Loop Rec_from.Close Next t Rec_to.AddNew Rec_to!FORMATED_LINE = "D" & FillTxt(Str(v_count), "0", 8, "L") & FillTxt(Str(v_shar), "0", 10, "L") & FillTxt(Str(v_value), "0", 15, "L") Rec_to.Update Rec_to.Close MsgBox "Done" End Sub

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