2017-01-28 1 views
2

私は、配列式によって返される結果によってかなり異なるテキストがある状況を解決しようとしています。場合によっては5行のデータがあり、それ以外には2000年があるかもしれません。3つのVBAコマンドを1つにマージするには?絶対参照を使わないで印刷範囲を設定する

完了したいタスクの各段階に必要な個々の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" 

を調整するために、次のステップを必要とするのに対し、しかし、私が発見したコードは、(下記のとおり)絶対的な範囲を設定するために私を必要としているようです私は取り入れたいです私は現在のワークシートを印刷するためのcontexturesのウェブサイトから経由で見つかったこのコード:

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 

は私がコードの単一の文字列にして、上記のすべてをしてください組み込む助けることができる誰か?

FURTHER EDIT

私はコードの異なる塊でやってまだわかりません。私は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 
+0

と呼びます。現在のワークシートを印刷したいだけですか?コード(コンテキスト1)は、スペースやピリオドの置き換えなど、他の処理も行います。私はあなたが何をする必要があるかについてはっきりしていません。また、[.Select'/'.Activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros)の使用を避ける方法を読んでください。質問の一部に答えるのに役立つかもしれません。 – BruceWayne

答えて

0

があなたの現在のコードで最も簡単な方法にフィットするには、ここにありますどのようにあなたが設定印刷範囲を希望:

ActiveSheet.PageSetup.PrintArea = Selection.address 

そして、あなたはあなたのルーチンを呼び出すことができます最後のノートでオーダー

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

で、あなたのコードは、修飾されていない範囲を使用してusuallあるを選択し、選択、ActivateSheet等...に多くを数えますyは悪い習慣とみなされます(コードは維持するのが難しいでしょう)。これらを削除し、明示的なシート名と修飾された範囲を使用するように変更する方がよいでしょう。

EDITコード・モジュール内のすべてのこれを置く

' 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

+0

本当にありがとうございます。したがって、これを適用したいシートを「レポート」と呼びたい場合は、「Dim ws As Worksheet」を使用してvbaを開始するソリューションですか? ws =ワークシート(「レポート」)を設定しますか? – user1883984

+0

シートの名前がわかったので、私は自分の答えにそれらの「選択」物をどのように落とすかの指示を加えます。 –

+0

ありがとうございます。素朴な質問に対する謝罪ですが、私はすべてのコードを1つのスクリプトとして連鎖させる方法をあまり理解していません。コンソールでこれを最初から最後までどのように構成する必要がありますか? – user1883984

関連する問題