vba - 如何将 3 个 VBA 命令合并为一个？设置无绝对引用的打印范围

Question

我正在尝试解决这样一种情况，即我的文本范围可能会根据数组公式返回的结果而有很大差异。有时可能有 5 行数据，有时可能有 2000 行。

我想我已经找到了我想要完成的任务的每个阶段所需的大量单独的 VBA 代码，但我是 VBA 的新手，我不知道如何将这些拼凑在一起。

以下选择页面上的所有实际数据，并排除任何包含隐藏公式的行:

Sub PickedActualUsedRange()
  Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select

End Sub

到目前为止，一切都很好。这是我要打印的确切范围。

我还希望自动调整行高，因为每个单元格都可能包含一串长度不同的文本，这些文本可能会被换行。所以再次需要输入以下命令:

Selection.Rows.AutoFit

到目前为止没有太多麻烦。

但是，对于下一点，我希望 VBA 使用上面所做的选择，并将其设置为新的打印范围。但是，我发现的代码似乎需要我设置一个绝对范围(如下所示)，而我需要根据第一个选择进行调整

Selection.PageSetup.PrintArea = "$A$1:$B$12"

一旦到位，我想加入的下一步是我从上下文网站找到的用于打印当前工作表的代码:

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub

有人能帮我将以上所有内容合并到一个代码字符串中吗？

进一步编辑

仍然不确定我在用不同的代码块做什么。我需要在 Module1 中输入的确切文本是什么？我不明白如何构造它:

'Function to give the actual data range from a given worksheet
Function PickedActualUsedRange(ws As Worksheet) As Range
 Set PickedActualUsedRange = ws.Range("A1").Resize(Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
End Function

Sub PDFSheet(wsA As Worksheet) '<-- the sheet in question will be given as parameter
    ' Drop or change the following lines...

    ' Dim wsA As Worksheet '<-- drop
    ' Dim wbA As Workbook  '<-- drop
    ...
    strPath = wsA.Parent.Path ' <-- change
    ...
End Sub

Sub mySyb()
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")

'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
  strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strPathFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
    wsA.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=myFile, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
    'confirmation message with file info
    MsgBox "PDF file has been created: " _
      & vbCrLf _
      & myFile
End If

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file"
    Resume exitHandler
End Sub
End Sub

Sub mySyb()
Dim ws As Worksheet: Set ws = Worksheets("report")
Dim r As Range: Set r = PickedActualUsedRange(ws)
r.Rows.AutoFit
ws.PageSetup.PrintArea = r.Address
PDFSheet (ws)
End Sub

Answer 1

为了以最简单的方式与您当前的代码相匹配，以下是您设置打印区域的方法:

ActiveSheet.PageSetup.PrintArea = Selection.address

你可以按顺序调用你的例程

PickedActualUsedRange
Selection.Rows.AutoFit
ActiveSheet.PageSetup.PrintArea = Selection.address
PDFActiveSheet

最后一点，您的代码使用了不合格的范围，并且在 Select、Selection、ActivateSheet 等方面非常重要……这通常被认为是不好的做法(代码将难以维护)。您最好更改它以摆脱这些并使用明确的工作表名称和限定范围。

编辑

' Function to give the actual data range from a given worksheet
Function PickedActualUsedRange(ws as Worksheet) as Range
 Set PickedActualUsedRange = ws.Range("A1").Resize(ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
      ws.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
      SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
End Function

Sub PDFSheet(wsA As Worksheet)
    'www.contextures.com
    'for Excel 2010 and later
    Dim strTime As String, strName As String, strPath As String, strFile As String, strPathFile As String
    Dim myFile As Variant
    On Error GoTo errHandler

    strTime = Format(Now(), "yyyymmdd\_hhmm")

    'get active workbook folder, if saved
    strPath = wsA.Parent.Path & "\"

    'replace spaces and periods in sheet name
    strName = Replace(wsA.Name, " ", "")
    strName = Replace(strName, ".", "_")

    'create default name for savng file
    strFile = strName & "_" & strTime & ".pdf"
    strPathFile = strPath & strFile

    myFile = Application.GetSaveAsFilename _
        (InitialFileName:=strPathFile, _
            FileFilter:="PDF Files (*.pdf), *.pdf", _
            Title:="Select Folder and FileName to save")

    'export to PDF if a folder was selected
    If myFile <> "False" Then
        wsA.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        'confirmation message with file info
        MsgBox "PDF file has been created: " _
          & vbCrLf _
          & myFile
    End If

exitHandler:
        Exit Sub
errHandler:
        MsgBox "Could not create PDF file"
        Resume exitHandler
End Sub

Sub myMacro
    Dim ws as worksheet: Set ws = Worksheets("report")
    Dim r as range: Set r = PickedActualUsedRange(ws)
    r.Rows.AutoFit
    ws.PageSetup.PrintArea = r.address
    PDFSheet ws
End Sub

将所有这些放入代码模块(即 Module1)并调用 myMacro通过 ALT
+ F8