将 Excel Sheet 转换为 PDF,无限循环错误
Convert Excel Sheet to PDFs, Infinite Loop Error
我在论坛上使用了一些代码来创建一个从 excel 中的单个 sheet 导出 PDF 的宏。每个 PDF 都包含 header 和与员工相关的所有行(所有带有员工 ID 的行)。当我 运行 一切顺利并且 pdf 正确时,但是宏永远不会停止 运行ning.
我相信我已经创建了一个无限循环,但不确定如何更正它。
它还会创建一个仅包含不需要的 header 的 PDF。
Sub PracticeToPDF()
Dim ws As Worksheet
Dim ws_unique As Worksheet
Dim DataRange As Range
Dim iLastRow As Long
Dim iLastRow_unique As Long
Dim UniqueRng As Range
Dim Cell As Range
Dim LastRow As Long
Dim LastColumn As Long
Application.ScreenUpdating = False
'Note that the macro will save the pdf files in this active directory so you should save in an appropriate folder
DirectoryLocation = ActiveWorkbook.Path
Set ws = Worksheets("BootVSPayroll") 'Amend to reflect the sheet you wish to work with
Set ws_unique = Worksheets("BootVSPayroll") 'Amend to reflect the sheet you wish to work with
'Find the last row in each worksheet
iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
iLastRow_unique = ws_unique.Cells(Rows.Count, "A").End(xlUp).Row
With ws
'I've set my range to reflect my headers which are fixed for this report
Set DataRange = ws.Range("$A:$K" & iLastRow)
'autofilter field is 4 as I want to print based on the practice value in column D
DataRange.AutoFilter Field:=1
Set UniqueRng = ws_unique.Range("A1:A20" & iLastRow_unique)
For Each Cell In UniqueRng
DataRange.AutoFilter Field:=1, Criteria1:=Cell
Name = DirectoryLocation & "\" & Cell.Value & " BOOT Report" & ".pdf"
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Next Cell
End With
With ws
.Protect Userinterfaceonly:=True, _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingColumns:=True, AllowFormattingRows:=True
.EnableOutlining = True
.EnableAutoFilter = True
If .FilterMode Then
.ShowAllData
End If
End With
Application.ScreenUpdating = True
End Sub
您的意思是:
Set DataRange = ws.Range("$A:$K" & iLastRow)
...
Set UniqueRng = ws_unique.Range("A1:A20" & iLastRow_unique)
改为:
Set DataRange = ws.Range("$A:$K$" & iLastRow)
...
Set UniqueRng = ws_unique.Range("A1:A" & iLastRow_unique)
?
例如,如果(取自 ws_unique)您最后使用的行,iLastRow_unique
等于 200,则 "A1:A20" & iLastRow_unique
等同于 "A1:A20200"
-- 这可能我想你打算循环的行要多得多。
我在论坛上使用了一些代码来创建一个从 excel 中的单个 sheet 导出 PDF 的宏。每个 PDF 都包含 header 和与员工相关的所有行(所有带有员工 ID 的行)。当我 运行 一切顺利并且 pdf 正确时,但是宏永远不会停止 运行ning.
我相信我已经创建了一个无限循环,但不确定如何更正它。
它还会创建一个仅包含不需要的 header 的 PDF。
Sub PracticeToPDF()
Dim ws As Worksheet
Dim ws_unique As Worksheet
Dim DataRange As Range
Dim iLastRow As Long
Dim iLastRow_unique As Long
Dim UniqueRng As Range
Dim Cell As Range
Dim LastRow As Long
Dim LastColumn As Long
Application.ScreenUpdating = False
'Note that the macro will save the pdf files in this active directory so you should save in an appropriate folder
DirectoryLocation = ActiveWorkbook.Path
Set ws = Worksheets("BootVSPayroll") 'Amend to reflect the sheet you wish to work with
Set ws_unique = Worksheets("BootVSPayroll") 'Amend to reflect the sheet you wish to work with
'Find the last row in each worksheet
iLastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
iLastRow_unique = ws_unique.Cells(Rows.Count, "A").End(xlUp).Row
With ws
'I've set my range to reflect my headers which are fixed for this report
Set DataRange = ws.Range("$A:$K" & iLastRow)
'autofilter field is 4 as I want to print based on the practice value in column D
DataRange.AutoFilter Field:=1
Set UniqueRng = ws_unique.Range("A1:A20" & iLastRow_unique)
For Each Cell In UniqueRng
DataRange.AutoFilter Field:=1, Criteria1:=Cell
Name = DirectoryLocation & "\" & Cell.Value & " BOOT Report" & ".pdf"
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Name _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Next Cell
End With
With ws
.Protect Userinterfaceonly:=True, _
DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingColumns:=True, AllowFormattingRows:=True
.EnableOutlining = True
.EnableAutoFilter = True
If .FilterMode Then
.ShowAllData
End If
End With
Application.ScreenUpdating = True
End Sub
您的意思是:
Set DataRange = ws.Range("$A:$K" & iLastRow)
...
Set UniqueRng = ws_unique.Range("A1:A20" & iLastRow_unique)
改为:
Set DataRange = ws.Range("$A:$K$" & iLastRow)
...
Set UniqueRng = ws_unique.Range("A1:A" & iLastRow_unique)
?
例如,如果(取自 ws_unique)您最后使用的行,iLastRow_unique
等于 200,则 "A1:A20" & iLastRow_unique
等同于 "A1:A20200"
-- 这可能我想你打算循环的行要多得多。