如何将3个VBA命令合并到一个？ 设置打印范围没有绝对参考

我试图解决的情况下，我有一个文本的范围可以相差很大取决于数组公式返回的结果。 有时可能有5行数据，其他时间可能有2000行。

我想我已经find了我要完成的任务的每个阶段所需的单个VBA代码块，但是我是一个完全的VBA新手，我不知道如何将它们拼凑在一起。

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

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 

到现在为止还挺好。 这是我想打印的确切范围。

我也希望行高度自动调整，因为每个单元格可能包含可能被包裹的不同长度的文本string。 所以再次下面的命令需要进入：

 Selection.Rows.AutoFit 

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

但是，接下来我想让VBA使用上面所做的select，并将其设置为新的打印范围。 但是，我发现的代码似乎要求我设置一个绝对范围（如下所示），而我需要根据第一个select进行调整

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

一旦这个到位，我想要合并的下一个步骤就是我通过contextures网站从打印当前工作表中find的代码：

 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 

有没有人能够帮助我将上述所有内容整合到单个代码string中？

进一步编辑

仍然不知道我在做什么与不同的代码块。 我需要在Module1中input什么文字？ 我不明白如何构build它：

 '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 

将所有这些放在一个代码模块（即模块1）中，并通过ALT + F8调用myMacro