excel to pdf忽略打印区域并调用打印机

时间:2016-11-20 08:43:12

标签: excel excel-vba pdf vba

这会循环显示学生列表,但在打印区域失败,该区域在导出行中设置和编码 - 当每个学生应该只有一个时,它会打印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

1 个答案:

答案 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