[[20191105162505]]　『pdf化の際のセル幅』（ポテチくん）　ページの最後に飛ぶ

『pdf化の際のセル幅』（ポテチくん）

初めて質問させていただきます。
下記VBAコードにpdf出力した際のセル幅に関する記述はありますか？
（pdfに出力するとなぜかセル幅が大幅に伸びた状態になってしまいます）
退職した者が作成したコードで、調べてみてもわからなかったので…

Option Explicit

'--------------------------------------------------
'定数（全体設定）
'--------------------------------------------------
Const PRINT_START_INDEX_CELL = "B3"
Const PRINT_END_IDEX_CELL = "B4"
Const PRINT_INDEX_CELL = "B2"
Const SAVE_FILE_NAME_CELL = "B12"
'--------------------------------------------------

Sub SaveAsPDF1RecordPerPage()

    Call SaveAsPDF(1)
End Sub

Sub SaveAsPDF2RecordPerPage()

    Call SaveAsPDF(2)
End Sub

'
' PDF保存 Macro
'
Sub SaveAsPDF(Optional recordCountPerPage As Integer = 1)
On Error GoTo ERR_EXIT

    If Range(PRINT_START_INDEX_CELL).Value > Range(PRINT_END_IDEX_CELL).Value Then
        MsgBox "印刷終了番号（TO）は印刷開始番号（FROM）より大きい必要があります。", vbCritical, "印刷対象指定エラー"
        Exit Sub
    End If

    If vbNo = MsgBox("指定された範囲のデータを差し込み、PDF保存しますがよろしいですか？" & vbCrLf & _
                    "対象データ件数：" & Range(PRINT_END_IDEX_CELL).Value - Range(PRINT_START_INDEX_CELL).Value + 1, _
                    vbQuestion + vbYesNo) Then
        Exit Sub
    End If

    '新規book作成
    Dim newBook As Workbook
    Set newBook = Workbooks.Add

    ThisWorkbook.Activate

    'サブディレクトリに保存する
    'Dim outputPath: outputPath = ThisWorkbook.Path & "\証明書PDF出力"
    'If Dir(outputPath, vbDirectory) = "" Then
    '    MkDir outputPath
    'End If

    Const COPY_SHEET_NAME_PREFIX = "COPY-"

    Dim print_index_from: print_index_from = Range(PRINT_START_INDEX_CELL).Value
    Dim print_index_to: print_index_to = Range(PRINT_END_IDEX_CELL).Value

    Dim printIndexNo
    For printIndexNo = print_index_from To print_index_to
        '印刷対象のIndexNoを設定
        ThisWorkbook.ActiveSheet.Range(PRINT_INDEX_CELL).Value = printIndexNo

        'Newbookの末尾にコピー
        ThisWorkbook.ActiveSheet.Copy After:=newBook.Sheets(newBook.Sheets.Count)

        'コピーしたシート名を変更

        newBook.ActiveSheet.Name = COPY_SHEET_NAME_PREFIX & newBook.Sheets.Count

        '1ページに印刷するレコード件数分を調整する
        printIndexNo = printIndexNo + (recordCountPerPage - 1)
    Next

    '警告メッセージをOFFにする
    Application.DisplayAlerts = False

    'newBookの全シートをチェックし、初期シートの空シートを削除する
    Dim ws As Worksheet
    For Each ws In newBook.Worksheets
        If Left(ws.Name, Len(COPY_SHEET_NAME_PREFIX)) <> COPY_SHEET_NAME_PREFIX Then
            ws.Delete
        End If
    Next

    'すべてのシートを選択
    newBook.Sheets.Select

    '保存ファイル名
    Dim savePath As String
    savePath = ThisWorkbook.Path & "\" & Range(SAVE_FILE_NAME_CELL).Value & "[" & Range(PRINT_START_INDEX_CELL).Value & "-" & Range(PRINT_END_IDEX_CELL).Value & "].pdf"

    'PDFにエクスポートする
    ActiveSheet.ExportAsFixedFormat _
         Type:=xlTypePDF, _
         Filename:=savePath, _
         Quality:=xlQualityStandard, _
        OpenAfterPublish:=True

    '一時ファイルを保存せずに閉じる
    newBook.Close False

    '警告メッセージをONに戻す
    Application.DisplayAlerts = True

    MsgBox "PDF出力が完了しました。", vbInformation
    Exit Sub

ERR_EXIT:

    MsgBox "ERROR:" & Err.Description

End Sub

'
' 直接印刷
'
Sub PrintDirect1RecordPerPage()

    Call PrintDirect(1)
End Sub

Sub PrintDirect2RecordPerPage()

    Call PrintDirect(2)
End Sub

Sub PrintDirect(Optional recordCountPerPage As Integer = 1)
On Error GoTo ERR_EXIT

    If Range(PRINT_START_INDEX_CELL).Value > Range(PRINT_END_IDEX_CELL).Value Then
        MsgBox "印刷終了番号（TO）は印刷開始番号（FROM）より大きい必要があります。", vbCritical, "印刷対象指定エラー"
        Exit Sub
    End If

    If vbNo = MsgBox("指定された範囲のデータを差し込み、プリンター（通常使うプリンター）に直接印刷しますがよろしいですか？" & vbCrLf & _
                    "対象データ件数：" & Range(PRINT_END_IDEX_CELL).Value - Range(PRINT_START_INDEX_CELL).Value + 1, _
                    vbQuestion + vbYesNo) Then
        Exit Sub
    End If

    Dim print_index_from: print_index_from = Range(PRINT_START_INDEX_CELL).Value
    Dim print_index_to: print_index_to = Range(PRINT_END_IDEX_CELL).Value

    Dim printIndexNo
    For printIndexNo = print_index_from To print_index_to
        Range(PRINT_INDEX_CELL).Value = printIndexNo

        '印刷
        ActiveSheet.PrintOut

        '1ページに印刷するレコード件数分を調整する
        printIndexNo = printIndexNo + (recordCountPerPage - 1)
    Next

    MsgBox "印刷を完了しました。", vbInformation
    Exit Sub

ERR_EXIT:

    MsgBox "ERROR:" & Err.Description

End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

コメント返信：

[ 一覧(最新更新順) ]

[[20191105162505]] 『pdf化の際のセル幅』（ポテチくん） ページの最後に飛ぶ

[[20191105162505]]　『pdf化の際のセル幅』（ポテチくん）　ページの最後に飛ぶ