ActiveSheet(액티브 시트) 또는 Select(선택)를 사용하지 않고 여러 시트를 동시에 PDF로 내보내기

ActiveSheet(액티브 시트) 또는 Select(선택)를 사용하지 않고 여러 시트를 동시에 PDF로 내보내기

버그를 방지하고 좋은 사용자 환경을 제공하기 위해 사용하지 않는 것이 가장 좋습니다..Select,.Activate,ActiveSheet,ActiveCell,기타.

이 점을 염두에 두고, 다음을 사용할 수 있는 방법이 있습니까?.ExportAsFixedFormat의 하위 집합에 대한 메서드Sheets위의 것 중 하나를 사용하지 않고 워크북에 있습니까?지금까지 제가 할 수 있는 유일한 방법은 다음 중 하나입니다.

1. 을 사용합니다.For Each그러나 이로 인해 별도의 PDF 파일이 생성되므로 좋지 않습니다.

2. 매크로 레코더에 의해 생성된 것과 유사한 코드를 사용합니다..Select그리고.ActiveSheet:

   Sheets(Array("Sheet1", "Chart1", "Sheet2", "Chart2")).Select
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       "exported file.pdf", Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= True
   

아마도 사용하지 않는 것은 불가능할 것입니다.ActiveSheet하지만 적어도 내가 사용할 수 있는 것은.Select어떻게든?

시도해 본 적이 있습니다.

Sheets(Array("Sheet1", "Chart1", "Sheet2","Chart2")).ExportAsFixedFormatType:= _
    xlTypePDF, Filename:= "exported file.pdf", Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, IgnorePrintAreas:=False, openafterpublish:= _
    True

이를 통해 다음과 같은 이점을 얻을 수 있습니다.

오류 438: 개체가 이 속성 또는 메서드를 지원하지 않습니다.

오래된 질문을 꺼내긴 싫지만, 누군가가 다른 대답에서 코드 체조에 의지하여 이 질문을 건너가는 것을 보고 싶지 않습니다.그ExportAsFixedFormat메서드는 표시되는 워크시트 및 차트만 내보냅니다.이것은 훨씬 더 깨끗하고 안전하며 쉽습니다.

Sub Sample()

    ToggleVisible False

    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        "exported file.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True

    ToggleVisible True

End Sub

Private Sub ToggleVisible(state As Boolean)
    Dim ws As Object

    For Each ws In ThisWorkbook.Sheets
        Select Case ws.Name
        Case "Sheet1", "Chart1", "Sheet2", "Chart2"
        Case Else
            ws.Visible = state
        End Select
    Next ws
End Sub

그것은 (많은...을 통해) 내 머릿속에 주입되었습니다.

무슨 말인지 알아요 ;)

사용하지 않는 한 가지 방법이 있습니다..Select/.Activate/ActiveSheet

논리:

1. 불필요한 시트 삭제
2. 전체 워크북을 내보냅니다.
3. 삭제된 시트를 다시 가져올 수 있도록 저장하지 않고 워크북 닫기

코드:

Sub Sample()
    Dim ws As Object

    On Error GoTo Whoa '<~~ Required as we will work with events

    '~~> Required so that deleted sheets/charts don't give you Ref# errors
    Application.Calculation = xlCalculationManual

    For Each ws In ThisWorkbook.Sheets
        Select Case ws.Name
        Case "Sheet1", "Chart1", "Sheet2", "Chart2"
        Case Else
            Application.DisplayAlerts = False
            ws.Delete
            Application.DisplayAlerts = True
        End Select
    Next ws

    '~~> Use ThisWorkbook instead of ActiveSheet
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    "exported file.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, openafterpublish:=True

LetsContinue:
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    '~~> VERY IMPORTANT! This ensures that you get your deleted sheets back.
    ThisWorkbook.Close SaveChanges:=False

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

편집: 현재 받아들여진 답변으로 인해 이 아이디어가 완전히 불필요하게 되었다는 소식을 전하게 되어 기쁩니다.

싯다스 루트에게 이 일을 할 수 있는 방법을 알려주셔서 감사합니다!

편집: 아래에 쓰여 있는 것처럼 이 모듈은 대부분 작동하지만 완전히 작동하지는 않습니다. 제가 안고 있는 문제는 차트가 참조하는 시트가 삭제된 후에 해당 데이터를 보관하지 않는다는 것입니다(이는 차트가 포함되었음에도 불구하고pApp.Calculation = xlCalculationManual명령).저는 이것을 고치는 방법을 찾지 못했습니다.업데이트할 때 업데이트합니다.

아래는 이 문제를 해결하기 위한 클래스 모듈(이 답변의 방법론 구현)입니다.그것이 누군가에게 유용하거나, 사람들이 그것이 그들에게 효과가 없다면 그것에 대한 피드백을 제공할 수 있기를 바랍니다.

Workbook.cls 작업 중

'**********WorkingWorkbook Class*********'
'Written By: Rick Teachey                '
'Creates a "working copy" of the desired '
'workbook to be used for any number of   '
'disparate tasks. The working copy is    '
'destroyed once the class object goes out'
'of scope. The original workbook is not  '
'affected in any way whatsoever (well, I '
'hope, anyway!)                          '
''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private pApp As Excel.Application
Private pWorkBook As Workbook
Private pFullName As String

Property Get Book() As Workbook
    Set Book = pWorkBook
End Property

Public Sub Init(CurrentWorkbook As Workbook)
    Application.DisplayAlerts = False

    Dim NewName As String
    NewName = CurrentWorkbook.FullName

    'Append _1 onto the file name for the new (temporary) file
    Do
        NewName = Mid(NewName, 1, InStr(Len(NewName) - 4, NewName, ".") - 1) _
        & Replace(NewName, ".", "_1.", Len(NewName) - 4, 1)
    'Check if the file already exists; if so, append _1 again
    Loop While (Len(Dir(NewName)) <> 0)

    'Save the working copy file
    CurrentWorkbook.SaveCopyAs NewName
    'Open the working copy file in the background
    pApp.Workbooks.Open NewName
    'Set class members
    Set pWorkBook = pApp.Workbooks(Dir(NewName))
    pFullName = pWorkBook.FullName

    Application.DisplayAlerts = True
End Sub

Private Sub Class_Initialize()
    'Do all the work in the background
    Set pApp = New Excel.Application
    'This is the default anyway so probably unnecessary
    pApp.Visible = False
    'Could probably do without this? Well just in case...
    pApp.DisplayAlerts = False
    'Workaround to prevent the manual calculation line from causing an error
    pApp.Workbooks.Add
    'Prevent anything in the working copy from being recalculated when opened
    pApp.Calculation = xlCalculationManual
    'Also probably unncessary, but just in case
    pApp.CalculateBeforeSave = False
    'Two more unnecessary steps, but it makes me feel good
    Set pWorkBook = Nothing
    pFullName = ""
End Sub

Private Sub Class_Terminate()
    'Close the working copy (if it is still open)
    If Not pWorkBook Is Nothing Then
        On Error Resume Next
        pWorkBook.Close savechanges:=False
        On Error GoTo 0
        Set pWorkBook = Nothing
    End If
    'Destroy the working copy on the disk (if it is there)
    If Len(Dir(pFullName)) <> 0 Then
        Kill pFullName
    End If
    'Quit the background Excel process and tidy up (if needed)
    If Not pApp Is Nothing Then
        pApp.Quit
        Set pApp = Nothing
    End If
End Sub

테스트 절차

Sub test()
    Dim wwb As WorkingWorkbook
    Set wwb = New WorkingWorkbook
    Call wwb.Init(ActiveWorkbook)

    Dim wb As Workbook
    Set wb = wwb.Book
    Debug.Print wb.FullName
End Sub

새 WB를 생성하지 않는 옵션:

    Option Explicit

Sub fnSheetArrayPrintToPDF()
    Dim strFolderPath As String
    Dim strSheetNamesList As String
    Dim varArray() As Variant
    Dim bytSheet As Byte
    Dim strPDFFileName As String
    Dim strCharSep As String

    strCharSep = ","
    strPDFFileName = "SheetsPrinted"

    strSheetNamesList = ActiveSheet.Range("A1")
    If Trim(strSheetNamesList) = "" Then
        MsgBox "Sheet list is empty. Check it. > ActiveSheet.Range(''A1'')"
        GoTo lblExit
    End If
    For bytSheet = 0 To UBound(Split(strSheetNamesList, strCharSep, , vbTextCompare))
        ReDim Preserve varArray(bytSheet)
        varArray(bytSheet) = Trim(Split(strSheetNamesList, strCharSep, , vbTextCompare)(bytSheet))
    Next

    strFolderPath = Environ("USERPROFILE") & "\Desktop\pdf\"
    On Error Resume Next
    MkDir strFolderPath
    On Error GoTo 0

    If Dir(strFolderPath, vbDirectory) = "" Then
        MsgBox "Err attempting to create the folder: '" & strFolderPath & "'."
        GoTo lblExit
    End If

    Sheets(varArray).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strFolderPath & strPDFFileName, _
                                    OpenAfterPublish:=False, IgnorePrintAreas:=False
    MsgBox "Print success." & vbNewLine & " Folder: " & strFolderPath, vbExclamation, "Printing to PDF"

lblExit:
    Exit Sub

End Sub

언급URL : https://stackoverflow.com/questions/22796286/export-multiple-sheets-to-pdf-simultaneously-without-using-activesheet-or-select