Planning and Production企画制作部 商品開発ブログ

【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


実行

できました！

こんな感じで、普段の作業も少し工夫すればもっと楽になるのではないかと思います。