【InDesign】ページ単位でリンクファイルをフォルダー分け

2019/09/28

DTP

はじめに

1000ページ超えのカタログを作った後に、お客様から「カタログに使っている画像をすぐに探せるように、ページごとにフォルダ分けしてほしい」というご依頼がありました。

カタログはAdobe InDesign CCで制作したもの。InDesignにはページごとに書き出す機能はないので、手動で1000ページ分フォルダ分けするという途方もない作業！これは困ったということで、なんとか楽をする方法はないかと考えてみました。

パッケージ機能で書き出し

パッケージ機能は、リンクファイルを「Link」フォルダーに一気に収集してくれます。しかし、フォルダ分けまではしてくれません

リンクパネルから情報をコピー

InDesignでは、リンクパネルからリンク情報が取り出せます。この情報を利用して自動化できそうです。

リンクパネルからリンク項目をすべて選択し、リンクパネル右上「三」から、情報をコピー＞選択されたリンクの情報をコピー（「名前」「ステータス」「ページ」という順で書き出されます。）

あらかじめ、ファイル＞パッケージでリンクファイルをまとめておきます。

EXCELを使って処理

リンク情報をもとにリンクファイルをページごとに分けていきます。今回はEXCELを使って自動化しようと思います。先ほどコピーした内容を、＞右クリック＞形式を選択してペースト＞テキストでEXCELに貼り付けます。

マクロを使って自動化

ここで問題発生。macOSXのEXCELマクロからではファイル操作が行えないため、WindowsのEXCELでチャレンジしてみます。

※Windowsで使えないファイル名がある場合はエラーになります。事前に変換してください。

設定

最初に、ファイル・フォルダー操作のための設定を行います。

EXCEL＞表示＞マクロ＞マクロの表示

マクロ＞編集

「Microsoft Visual Basic for Applications」が開きます。

ツール＞参照設定

「Microsoft Scripting Runtime」のチェックを入れます。

マクロをつくる

プログラム例を以下に掲載しておきます。

Option Explicit

Sub 画像フォルダー分け()
'
' Macro1
'
Dim Thisbook_path As String

    '実行中のマクロが記述されているブックのフォルダへの絶対パス
    Thisbook_path = ThisWorkbook.Path

    Dim fso As FileSystemObject
    Set fso = CreateObject("scripting.filesystemobject")
    Dim img As String
    Dim copyf As String
    img = Thisbook_path & "/Links/"
    copyf = Thisbook_path & "/copy/"
    
    'Linksフォルダ確認
    If Dir(img, vbDirectory) <> "" Then
    Else
      MsgBox ("InDesignでパッケージ書き出しした「Links」フォルダーを、このEXCELファイルと同じ階層に置いてください。")
      Exit Sub
    End If
    
    Application.ScreenUpdating = False '画面書き換え停止
    Application.Calculation = xlCalculationManual '自動計算を停止
    
    '
    Dim gyo As Long
    For gyo = 65536 To 1 Step -1
        If Cells(gyo, 1).Value <> "" Then Exit For
    Next gyo
    
        If Dir(copyf, vbDirectory) <> "" Then
        Else
          MkDir (copyf) 'copyフォルダ作成
        End If
        
   DoEvents

    Dim imgpass As String
    Dim copypass  As String
    Dim copypassf  As String
    Dim grf As Long
    Const grfMax = 20
    grf = Int(gyo / grfMax)
    Dim count As Long
    count = 0
    
    Dim i As Long
    For i = 2 To gyo
        imgpass = (img & (Cells(i, 1).Value))
        copypass = (copyf & (Cells(i, 3).Value) & "/")
        
        If Dir(copypass, vbDirectory) <> "" Then
        Else
          MkDir (copypass) 'フォルダーがない場合作成
        End If
        
            'ファイルコピー
            copypassf = (copypass & (Cells(i, 1).Value))
            
            If Dir(copypassf) <> "" Then
            Else
                Set fso = New FileSystemObject
                fso.CopyFile imgpass, copypass, True
                Set fso = Nothing
            End If
       
       If (i Mod grf) = 0 Then '経過表示処理
         Application.ScreenUpdating = True
         Application.StatusBar = "実行中…" & String(count, "■") & String(grfMax - count, "□")
         DoEvents
         Application.ScreenUpdating = False
         count = count + 1
       End If
       
    Next i
    
    Application.StatusBar = ""
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "処理完了"
    
End Sub