从VBA中的数组取消组合表格

时间:2016-10-07 19:18:16

标签: excel vba excel-vba

我一直试图在一张只有活动范围和一张图表位于另一张纸上的简单打印输出(使用单个按钮以PDF格式)。我已经完成了所有工作,除了我打印后,两张纸都组合在一起,我无法编辑我的图表。

我试图在实时操作中为同事做出这种万无一失的简单方法。现在我可以右键单击并选择“取消组合表格”。解决它,但我不想每次都这样做(或解释它需要完成)。

我试图选择一张纸,另一张纸,只有一张纸等。我无法弄清楚如何让VBA在最后取消纸张。有什么想法吗?

Sub CustomPrint()

'if statement to ask for file path
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                  Title:="Create PDF")

            'If you cancel this dialog, exit the function.
            If fname = False Then Exit Sub
        Else
            fname = FixedFilePathName
        End If

'Dynamic reference to RT drilling data
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Dim sht As Worksheet

Set sht = Worksheets("rt drilling data")
Set StartCell = Range("A1")

'Refresh UsedRange
  Worksheets("rt drilling data").UsedRange

'Find Last Row
  LastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Select Range
 sht.Range("A1:K" & LastRow).Select

Sheets("Chart Update").Activate
ActiveSheet.ChartObjects(1).Select

ThisWorkbook.Sheets(Array("chart update", "RT drilling data")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=fname, IgnorePrintAreas:=False
'If the export is successful, return the file name.
        If Dir(fname) <> "" Then RDB_Create_PDF = fname
    End If
 If OverwriteIfFileExist = False Then
            If Dir(fname) <> "" Then Exit Sub
        End If

   On Error GoTo 0

Worksheets("ws model updates").Select

End Sub

1 个答案:

答案 0 :(得分:0)

If Dir(fname) <> "" Then Exit Sub将绕过Worksheets("ws model updates").Select

If OverwriteIfFileExist = False Then
    If Dir(fname) <> "" Then 

        Worksheets("ws model updates").Select
        Exit Sub

    End If
End If