Excelマクロでpdfsを作成する

Question

Excelブックで各シートの個別のpdfを作成しようとしています。これは私が使用しているコードです。

Sub CreatePdfs() 
' CreatePdfs Macro 
' Keyboard Shortcut: Ctrl+o 
Dim ws As Worksheet 
Dim wsA As Worksheet 
Dim wbA As Workbook 
Dim strPath As String 
Dim strFile As String 
Dim strPathFile As String 
Dim myFile As Variant 
For Each ws In Worksheets 
Set wbA = ActiveWorkbook 
Set wsA = ActiveSheet 
strPath = wbA.Path 
If strPath = "" Then 
    strPath = Application.DefaultFilePath 
End If 
strPath = strPath & "\" 
strName = Replace(wsA.Name, " ", "") 
strName = Replace(strName, ".", "_") 
strFile = strName & ".pdf" 
strPathFile = strPath & strFile 
ws.Select 
nm = wsA.Name 

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPathFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False 

Next ws 
End Sub 

これは「ほとんど」機能します。それは、各シート（それが想定されている）ごとに別々のpdfファイルを作成し、Excelファイルと同じフォルダに保存しますが、間違って名前を付けます。たとえば、1,2,3,4という名前のワークブックに4枚のシートがある場合、シート2をpdfとして作成し、それに「1」という名前を付けます。 3は「2」、4は「3」、1は「4」となります。

コード内に何か不具合があります。

Answer 1

.Selectを使用しないと、その問題は発生しません。行Set wbA = ActiveWorkbookとSet wsA = ActiveSheetは必要ありません。またActiveSheet.ExportAsFixedFormat Type:=xlTypePDF...はws.ExportAsFixedFormat Type:=xlTypePDF...

なり、このコードに

Sub CreatePdfs() 
    ' CreatePdfs Macro 
    ' Keyboard Shortcut: Ctrl+o 
    Dim ws As Worksheet 
    Dim strPath As String, strFile As String, strPathFile As String 

    strPath = ThisWorkbook.Path 
    If strPath = "" Then strPath = Application.DefaultFilePath 
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 

    For Each ws In ThisWorkbook.Worksheets 
     strName = Replace(Replace(ws.Name, " ", ""), ".", "_") 
     strFile = strName & ".pdf" 
     strPathFile = strPath & strFile 

     ws.ExportAsFixedFormat Type:=xlTypePDF, _ 
     Filename:=strPathFile, Quality:=xlQualityStandard, _ 
     IncludeDocProperties:=True, IgnorePrintAreas:=False, _ 
     OpenAfterPublish:=False 
    Next ws 
End Sub