תבדוק את זה
דבר ראשון בניתי את זה לפני המון זמן, רצוי שלא תתן שמות בעברית כמו שאני נתתי. דבר שני עד כמה שאני זוכר עשיתי שם איזה פישול קטן שהיתי צריך ללכוד אותו בERR אבל זה עובד בסדר רק לא כל כך אלגנטי דבר שלשי שמתי מדידה לזמן רק לשם הדגמה כי בדקתי את זה ב 30.000 רשומות (פיקטיביות כמובן, הכנסתי באופן אוטומטי) וזה לוקח כמה דקות, דבר שקצת מעצבן דבר רביעי בקשר ל Application.Echo 0 תנטרל את זה עד שתראה שהכל עובד בסדר, אם יהיה לך בג זה יכול לעצור את המחשב ודבר רביעי בהצלחה
Private Sub פקודה61_Click() On Error GoTo er OrderByOn = True OrderBy = "תאריך_ערך" Dim T T = Timer Application.Echo 0 ´AllowAdditions = -1 Requery Refresh Dim ctl As Control, Schum Dim Dbs As Database Dim recS As Recordset Set Dbs = CurrentDb Set recS = Dbs.OpenRecordset("תזרים") DoCmd.GoToRecord , , acFirst Dim a As Integer For a = 0 To recS.RecordCount Schum = Schum + סכום סך_הכל = Schum DoCmd.GoToRecord , , acNext Next DoCmd.GoToRecord , , acFirst ex: DoCmd.GoToRecord , , acFirst ex1: Application.Echo -1 AllowAdditions = 0 MsgBox Format(Timer - T, "0.0") & " שניות ", vbInformation, "זמן חישוב יתרות" Idkun_TOTAL = Now txt_IDKUN_TIME = Format(Now, "dd/mm/yy hh:mm") Exit Sub er: If Err = 2105 Then Resume ex ´ If Err = 94 Then Resume ex If Err = 2427 Then MsgBox "עדיין אין פעילות, מומלץ לצאת מהטופס", vbInformation, "טופס ריק" Resume ex1 End If MsgBox Err ´.Description Resume ex1 End Sub
