[算表] VBA输出PDF于特定次数后发生问题

楼主: TSSH (只是过客)   2019-03-17 23:25:37
软件:OFFICE
版本:2019 64位元版
最近在跑公司资料产制图表输出,但无论用“ExportAsFixedFormat”或“Printout”的
方式处理,大约165笔左右就会异常,下方有测试时的录影纪录
1.不产出PDF理论上可以跑完全部资料
2019-03-17VBA测试纪录
https://youtu.be/4NK0B0OHt9U
http://tinyurl.com/y2o5jxzd
2.产出PDF
(1)以ExportAsFixedFormat的方式产出的资料较小
2019-03-17VBA测试纪录ExportAsFixedFormat
https://youtu.be/ZtYduSyLqnQ
http://tinyurl.com/y4yrqefq
(2)以printout方式产出的资料大约为ExportAsFixedFormat方法的2倍大小
2019-03-17VBA测试纪录print
https://youtu.be/219px5hiU2k
http://tinyurl.com/y2w2s5gs
系统资源不足,无法完整显示。
http://tinyurl.com/y4s9jyxk
但无论以何种方式,大约执行165笔后就会异常,观察截图后
读取量大小 Printout(178,665) > ExportAsFixedFormat(151,766) > 不产出
PDF(31,057)
写入量大小 ExportAsFixedFormat(655,688) > Printout(17,874) > 不产出PDF(5,786)
其他I/O大小 Printout(1,190,267) > ExportAsFixedFormat(948,638) > 不产出
PDF(104,833)
内存用量 ExportAsFixedFormat(231,952K) > Printout(229,096K) > 不产出
PDF(172,692K)
猜想应该是内存使用量的问题,但是不产出PDF下执行到499笔的内存量却不会发生“
系统资源不足,无法完整显示。”的问题,请问可能是哪个环节出了问题呢??
下方为转档时主要会用到的程式码
Sub export()
Dim FileName As String
Dim myFolder$
Dim MyFile As Object
Dim i As Integer, filemsg As Integer
myFolder = "D:\"
For i = 1 To 499
'暂停10秒
If i Mod 50 = 0 Then
ThisWorkbook.save
End If
Application.StatusBar = "目前进度" & i
myfilepath = myFolder & FileName & ".pdf"
输出.ExportAsFixedFormat Type:=xlTypePDF, FileName:=myfilepath,
Quality:=xlQualityStandard, IncludeDocProperties:=True,
IgnorePrintAreas:=False, OpenAfterPublish:=False 'ExportAsFixedFormat方法
'输出.PrintOut ActivePrinter:="Microsoft Print to PDF", Copies:=1,
Collate:=True, IgnorePrintAreas:=False, PrToFilename:=myfilepath 'printout方

Application.Wait Now() + TimeValue("00:00:01")
Set MyFile = CreateObject("Scripting.FileSystemObject") '检测档案大小
Application.Wait Now() + TimeValue("00:00:01")
With MyFile.Getfile(myfilepath)
filemsg = Round(.Size / 1024)
'判断档案大小
filesize = "档案大小:" & filemsg & "KB"
If filemsg < 50 Then
filelog = "档案错误,强制跳出循环"
MsgBox (filelog)
Exit For
End If
Set MyFile = Nothing
End With
Next
End Sub

Links booklink

Contact Us: admin [ a t ] ucptt.com