这会循环显示学生列表,但在打印区域失败,该区域在导出行中设置和编码 - 当每个学生应该只有一个时,它会打印130页。调用所有打印机打开一个对话框(登录6密码)并停止宏 - 打印机是网络上的工作打印机,并不总是可用。 有没有办法阻止打印机被调用? 并控制页面到打印区域?
Option Explicit
Sub PdfExportMacro()
Dim rCell As Range, rRng As Range
'Student numbers in cells A7:A160
Set rRng = Worksheets("studentlist").Range("A7:A160") '<--| set your "students" range
With Worksheets("Feedback") '<--| reference "Feedback" worksheet
For Each rCell In rRng '<--| loop through "students" range
.Range("A1").Value = rCell.Value '<--| write current student number to cell A1 on Feedback sheet
' Export & save file as pdf using SNum as filename:
.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
"Macintosh HD:Users:Michael:Desktop:" & rCell.Value, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next rCell
End With
End Sub
答案 0 :(得分:0)
所以我改变了轨道 - excel vba似乎不高兴用打印机设置生成pdf文件...... 因此,我更改为使用copy&amp; amp;导出每个学生的excel文件。粘贴特殊值和格式。这是我做的代码(从这里的其他答案中偷来的很多!谢谢......)欢迎任何关于改进代码的评论 - 我认为这有很大的范围!!
Option Explicit
Sub Exportmacro()
Dim rCell As Range, rRng As Range 'define loop names
Dim NewCaseFile As Workbook 'give a name to new work book for duplicate sheet
Dim wks As Worksheet 'name of the copy of feedback
Dim sPath As String
sPath = MacScript("(path to desktop folder as string)")
'turn off screen
With Application
' .ScreenUpdating = False ‘only removed while testing
' .EnableEvents = False
' .Calculation = xlCalculationManual ‘disabled for the moment
End With
'Student numbers in cells A7:A160 WARNING SET TO 3 STUDENTS ONLY FOR TEST
Set rRng = Worksheets("studentlist").Range("A7:A9")
With Worksheets("Feedback") '<--| reference "Feedback" worksheet
For Each rCell In rRng '<--| loop through "students" range
.Range("A1").Value = rCell.Value '<--| write current student number to cell A1 on Feedback sheet
'do copy ready for paste spec vals to destroy links & calculations
ActiveSheet.Range("A2:W77").Copy
'now open new workbook then pastespecial values and formats
Set NewCaseFile = Workbooks.Add
NewCaseFile.Sheets(1).Range("A1").PasteSpecial xlPasteValues
NewCaseFile.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
'now save as xls with student number as filename Filename:=sPath & rCell.Value & ".xlsx"
ActiveWorkbook.SaveAs Filename:=rCell.Value & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
'now close duplicate file
ActiveWorkbook.Close False
Next rCell '<-- next student number
End With '<-- once all done
'turn screen back on
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub