背表紙印刷マクロ

動きが不安定なマクロがあったので，書き直してみたのをメモ．

「紙に印刷したときの最終列に書き込んだときだけ，1列空ける必要なく隣の列に書き出し始めてよい」というのをmodを使ってまとめている．しかし，1cm幅のとき，うまくまとめれらなかったみたい．貼付先シートを1ページ15列にすればよいけど，16列になっていたので，気づかなかったのだろう．

Option Explicit

Sub cmd1cm集約()
    '背表紙1cm幅，1ページあたり15列
    Call 集約(1, 15)
End Sub
Sub cmd3cm集約()
    '背表紙3cm幅，1ページあたり7列
    Call 集約(3, 7)
End Sub
Sub cmd5cm集約()
    '背表紙5cm幅，1ページあたり5列
    Call 集約(5, 5)
End Sub
Sub cmd8cm集約()
    '背表紙8cm幅，1ページあたり3列
    Call 集約(8, 3)
End Sub

Private Sub 集約(lng背表紙幅 As Long, lng印刷に入る列数 As Long)
    'FSO事前バインディングが前提
    With New Scripting.FileSystemObject
        '格納フォルダがない場合は処理終了
        Dim strFolderPath As String: strFolderPath = ThisWorkbook.Path & "\格納フォルダ"
        If Not (.FolderExists(strFolderPath)) Then
            MsgBox "格納フォルダがありません．"
            Exit Sub
        End If
        
        Dim myFile As File
        For Each myFile In .GetFolder(strFolderPath).Files
            '格納フォルダ内に指定した幅の背表紙ファイルがあったら，集約シートにコピペする
            If myFile.Name Like "*" & lng背表紙幅 & "cm*" Then
                Dim lng入力列番号 As Long: lng入力列番号 = 1
                Call 集約シートへ転記(myFile.Path, lng入力列番号, lng背表紙幅)
                '印刷レイアウトの最終列かどうかで，次の入力列を1列空けるか空列不要かを判定
                Select Case lng入力列番号 Mod lng印刷に入る列数
                    '例．3cm幅のときに1(,3or5)列目を入力したら，次はの入力列は1列空けて3(,5or7)列目
                    Case Is > 0
                        lng入力列番号 = lng入力列番号 + 2
                    '例．3cm幅のときに7列目（印刷時1ページ目の最終列）を入力したら，次の入力列は８列目（印刷時2ページ目の先頭列）
                    Case Is = 0
                        lng入力列番号 = lng入力列番号 + 1
                End Select
            End If
        Next
    End With
    Application.Goto Sheets("集約（" & lng背表紙幅 & "cm用").Range("A1"), True
End Sub

Private Sub 集約シートへ転記(strFilePath As String, i As Long, lng背表紙幅 As Long)
    Dim aWB As Workbook: Set aWB = Workbooks.Open(strFilePath)
    With ThisWorkbook.Sheets("背表紙（" & lng背表紙幅 & "cm用")
        '初期化
        .Cells.ClearContents
        'コピペ （pasteSpecialより動きが安定する．）
        .Range("A1:A31") = aWB.Sheets("背表紙（" & lng背表紙幅 & "cm用").Range("A1:A31")
    End With
    aWB.Close savechanges:=False
End Sub