印刷設定を行うVBA インボイス見積納品請求伝票日付版

Option Explicit

Sub 印刷設定()
    Dim SaRow, KeRow, NRow, Pc As Long
    Dim a, s, b As Long
    Dim Fsa, Fsb As Variant         'インボイス3点操作パネルデータを使用
        Worksheets("作業シート").Select
        SaRow = Cells(Rows.Count, 5).End(xlUp).Row
'印刷の範囲を調べる
        If SaRow < 23 Then
            KeRow = 40
        Else
            KeRow = 40 + Application.WorksheetFunction. _
                        RoundUp((SaRow - 23) / 34, 0) * 34
        End If
'ページ数のカウント
        Pc = Application.WorksheetFunction. _
                        RoundUp((SaRow - 23) / 34, 0)
'印刷範囲を設定
        For a = 2 To 4
            Worksheets(a).Select
            With Worksheets(a)
                NRow = .Cells(Rows.Count, 1).End(xlUp).Row
                    .PageSetup.PrintArea = False
                    .PageSetup.PrintTitleRows = "$15:$15"
                If KeRow = 40 Then
                    .PageSetup.PrintArea = "A1:I40"
                Else
                    .PageSetup.PrintArea = "A1:I" & KeRow
                End If
'ページ番号
                .PageSetup.CenterFooter = "&P"
'固定のフォントサイズ（品名以外）
                .Range(Cells(16, 3), Cells(KeRow, 8)) _
                            .Font.Size = 11
                .Range(Cells(16, 1), Cells(KeRow, 1)) _
                            .Font.Size = 10
'品名のフォントサイズ
                .Range(Cells(14, 3), Cells(KeRow - 3, 3)).WrapText = True
                Fsa = インボイス3点操作パネル.品名F.Value
                If Fsa = "" Then
                    Fsa = 10
                Else
                    Fsa = Val(Fsa)
                End If
                .Range(Cells(14, 3), Cells(NRow, 3)) _
                            .Font.Size = Fsa
'品名の個別フォントサイズ
                If インボイス3点操作パネル.CheckBox4 = True Then
                    Call Module3.番号別フォントサイズ
                End If
'合計のフォントサイズ
                .Cells(NRow + 1, 2).Font.Size = 11
'顧客名のフォント
                Fsb = インボイス3点操作パネル.顧客F.Value
                If Fsb = "" Then
                    Fsb = 13
                Else
                    Fsb = Val(Fsb)
                End If
                .Range("B6").Font.Size = Fsb
'フォント種選択（ユーザーフォームから選択）
                If インボイス3点操作パネル.ComboBox1.Value = "" Then
                    .Cells.Font.Name = "ＭＳ Ｐゴシック"
                Else
                    .Cells.Font.Name = インボイス3点操作パネル.ComboBox1.Value
                End If
            End With
        Next a
'プレビュー画面を表示
        For b = 2 To 4
            Worksheets(b).PrintPreview
        Next b
'自動保存設定
        If インボイス3点操作パネル.CheckBox3 = True Then
            Module4.伝票保存
        End If
End Sub

Sub 番号別フォントサイズ()
    Dim HN() As String
    Dim HNRow As Long
    Dim HNList As String
    Dim Fsc As Long
    Dim a, i, Nomber As Long
        HNList = インボイス3点操作パネル.個別品名番号.Value
        Fsc = インボイス3点操作パネル.個別フォントサイズ.Value
        Fsc = Val(Fsc)
        For a = 2 To 4
            With Worksheets(a)
                .Select
'テキストボックスの文字列から数値を配列取り出し
                HN = Split(HNList, ",")
                For i = LBound(HN) To UBound(HN)
                    Nomber = Val(HN(i))
                    On Error Resume Next
'取り出した数値から行番号を調べる
                    HNRow = WorksheetFunction.Match(Nomber, _
                                .Range("A:A"), 0)
                    .Cells(HNRow, 3).Font.Size = Fsc
                    On Error GoTo 0
                Next i
            End With
        Next a
End Sub