Question

我一直在搜寻我的眼睛，我非常新手。

我正在使用宏浏览客户ID列表，使用ID过滤数据透视表，将工作表导出为pdf，然后重复循环。

几天后，我终于设法使其运行60次，但随后它重新启动了excel。我刚刚将页面文件从2gb增加到了16gb。

我正在使用do while循环，并且我试图设置对象=清除资源并即时保存文件，而且我也正在使用DoEvents，将screenupdate设置为false，将Microsoft xps设置为默认打印机，将comms打印为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

Answer 1

我现在在64位上运行246次循环，在32位上运行175次。两者都开始创建空的pdf文件，然后崩溃。但是，在删除这些图像之后，循环现在运行的时间更长。所以我想这是解决方案，现在我需要弄清楚如何防止损坏和清空pdf文件和/或发现它们并杀死宏。

因此，除非有人可以指向我的代码中的某个地方并告诉我“随着时间的流逝，这里会膨胀，并且使您的事情崩溃”，否则我假设我的代码有效，这只是内存的自然限制。

40或60个循环后，VBA循环崩溃

1 个答案: