Я выгуливал глаза, и я очень новичок.
Я использую макрос, чтобы просмотреть список идентификаторов клиентов, отфильтровать сводку с идентификатором, экспортироватьЛист в формате PDF, а затем повторите цикл.
Мне, наконец, через несколько дней удалось запустить его в течение 60 раз, но потом он перезапускает Excel.Я только что увеличил файл подкачки с 2 ГБ до 16 ГБ.
Я использую цикл do while, и я пытаюсь установить объекты = ничего, чтобы очистить ресурсы, и я сохраняю файл в одной точке, а также я использую DoEvents, установите для screenupdate значение false, установите для Microsoft XPS значениепринтер по умолчанию, выводит на печать значение false, все диапазоны хранятся в переменных вместо выбранных, рабочие листы также сохраняются в переменных вместо активации.Я пробовал проходить, используя точки останова и т. Д. И видеть, как он работает 60 раз без ошибок.
Я предполагаю, что, поскольку он увеличился с 40 до 60 до сбоя, это может быть связано с ресурсамисо временем раздувается.
Мой код, будучи новичком, может потребоваться очистить, так как он должен работать около 1000 раз без сбоев.Это смесь различных поисков в Google о том, как делать разные вещи.
Option Explicit
Public Global_Sti As String
Public Global_MD As String
Public Month As String
Public FirstKardex As Variant
Public Global_EnkeltSti As String
Dim restart As String
Sub exporterkardexfiler()
start:
restart = "yes"
Do While restart = "yes"
Call kørsel
Loop
End Sub
Sub kørsel()
Application.ScreenUpdating = False
Dim næsteRapportAntal As Integer
Dim næsterækketæller As Integer
Dim sh As Worksheet
Dim k As Long 'bruges til at tælle antal rækker der er kardex værdier i
Dim i As Integer 'bruges til løkken, skal køre så længe antallet af kørsler er mindre eller lig med i
Dim n As Integer 'antal handlinger inde i løkken, bruges som tæller op imod i
Dim row As Integer 'bruges til at tælle rækker
Dim kardexkol As Excel.Range
Dim temp As String
Dim tid As Date
Set sh = Worksheets("Pivoter")
Set kardexkol = sh.Range("A5") 'kolonne der skal findes kardex i
k = sh.Range("A2000").End(xlUp).row 'tæl antallet af celler med værdi i kolonne A
Call Stopwatch.WorkstAtMidnight(1) ' kald stopur modul med 1 for aktivering
i = k - 4 'antal rapporter der skal genereres
row = 1 + Range("lastrun").Value 'tæller til at skifte til næste række.
n = 1 + Range("AddFirstCount")
næsteRapportAntal = Worksheets("Rapport").Range("x10").Value 'tæller til at styre hvornår antal er ligmed i. Juster til højere tal for at begrænse rapport antal.
næsterækketæller = 1 'tæller til at styre hvilket nr næste række, der skal bruges data fra, har.
'opret en ny mappe med sidste måneds navn + år, baseret på filsti oplyst i ark"Filer":A6
Global_Sti = Range("pFiloutput1") & "\"
Call nymappe.lavmappe(Global_Sti)
Global_MD = Global_MD & "\"
Dim whs As Worksheet
Set whs = Worksheets("Rapport")
Dim printrng As Excel.Range
Set printrng = whs.Range("udskrift")
Dim GemtFil As String
Dim liste As Excel.Range
Set liste = sh.Range("A4:A1100")
On Error GoTo skip
With liste
Do While n <= i
Dim kardex As Variant
temp = "start do while"
kardex = kardexkol.Rows(row).Value
If kardex = "Hovedtotal" Then GoTo færdig
If n = 1 Then FirstKardex = kardex
'filtrer kardex pivot med kardex nr fundet med sub function fra modul filtrerekardexpivot
temp = "filtrer pivot1"
Call FiltrerKardexpivot.FiltrerKardexpivot(kardex)
temp = "filtrer pivot1 done"
tid = Now()
' Worksheets("error").Range("tid").Value = tid & " filtrer pivot save "
'opdater skærm, genberegn formler så farver matcher indeks-match opslag.
Worksheets("Billeder").Calculate
Application.Wait (Now + TimeValue("0:00:11")) 'pause så farvekoder passer
Application.DisplayAlerts = False
temp = "gem pdf"
Dim pdfnavn As String
pdfnavn = Global_MD & kardex & " - " & Month
On Error GoTo skip
Call exportPDF.exportPDF(printrng, pdfnavn)
On Error GoTo 0
temp = "gem pdf done"
'GemtFil = Global_MD & kardex & " - " & Month & ".pdf"
'Call SendEmail.SendEmail(email, "Månedsrapport affald - " & Month, GemtFil)
temp = "email"
'Set email = Nothing
'GemtFil = ""
Set kardex = Nothing
pdfnavn = ""
ActiveWorkbook.Save
Application.DisplayAlerts = True
Worksheets("Rapport").Range("lastrun") = row
n = n + næsteRapportAntal
row = row + næsterækketæller
If n = 60 Then GoTo restart
Loop
End With
On Error GoTo 0
færdig:
Call FiltrerKardexpivot.FiltrerKardexpivot(FirstKardex)
Call FiltrerKardexpivot.FiltrerKardex12(FirstKardex)
Worksheets("Rapport").Activate
Range("lastrun") = 0
Call Stopwatch.WorkstAtMidnight(0)
ActiveWorkbook.Save
restart = "no"
MsgBox ("Rapport Generator er nu Færdig!")
Exit Sub
skip:
Dim errortxt As String
MsgBox "Fejl!" & Err.Description & " kardex: " & kardex
tid = Now()
Worksheets("error").Range("tid").Value = tid & " Error save "
Worksheets("error").Range("temp").Value = temp
errortxt = "err num: " & Err.Number & "Err.Descrip: " & Err.Description & "Err.Source: " & Err.Source
Worksheets("error").Range("error").Value = errortxt
restart = "no"
ActiveWorkbook.Save
Exit Sub
On Error GoTo 0
restart:
MsgBox "restarting at nr " & n
restart = "yes"
Exit Sub
End Sub