strやassの字幕ファイルをAviUtlに取り込む方法

字幕を作るのはSubtitleworkshopなんかでやりたいんだけど、
画像に埋め込むのはAviutlでやりたい。
そういう時のメモ。

１．字幕ファイルを用意する
２．excelに読み込ませる
３．A列に開始秒、B列に終了秒、C列に字幕　となるように編集する
４．後述のマクロを実行する
５．作成されたファイル（_srt.exo）をAviutlで読み込む
　（拡張編集の何もないところで右クリック
　　→ファイル→オブジェクトファイルのインポート）

まぁこれが単純で楽ちんかなと。

かなり適当。
拡張編集のオブジェクトファイルがテキスト形式で分かりやすかったので
その形式に合わせて書き出すだけのマクロ。
もしかしたら、他にもっと簡単な方法があるのかもしれない。

注意点
字幕同士の間が１フレームもないと読み込みに失敗するもよう

ExcelのVBAでexoファイルをつくるマクロ

'1列目：開始秒
'2列目：終了秒
'3列目：字幕テキスト。改行＝\N
Sub str2AUEx()
    Dim datFile As String
    datFile = ActiveWorkbook.Path & "\_srt.exo" 'ファイル名
    Open datFile For Output As #1
    Dim fRate As Integer
        fRate = 30 'フレームレート
   
    'ヘッダ的な部分
    Print #1, "[exedit]"
    Print #1, "width=640"
    Print #1, "height=480"
    Print #1, "rate=" + Mid(Str(fRate), 2)
    Print #1, "scale=1"
    Print #1, "length=20"
    Print #1, "audio_rate=44100"
    Print #1, "audio_ch=2"
    Dim i As Long, j As Long, k As Integer
    Dim Zimaku As String, ZimakuUNI As String, preUNI As String
   
    i = 2 '２行目から開始にします
    j = 0 'ファイルに書き込む通しナンバー
    Do While Cells(i, 1).Value <> ""
        Print #1, "[" + Mid(Str(j), 2) + "]"
        Print #1, "start=" + Mid(Str(Int(Cells(i, 1).Value * fRate)), 2)
        Print #1, "end=" + Mid(Str(Int(Cells(i, 2).Value * fRate)), 2)
        Print #1, "layer=1" 'レイヤー
        Print #1, "overlay=1"
        Print #1, "camera=0"
        Print #1, "[" + Mid(Str(j), 2) + ".0]"
        Print #1, "_name=テキスト"
        Print #1, "サイズ=34" 'サイズ
        Print #1, "表示速度=0.0"
        Print #1, "文字毎に個別オブジェクト=0"
        Print #1, "移動座標上に表示する=0"
        Print #1, "自動スクロール=0"
        Print #1, "B=0"
        Print #1, "I=0"
        Print #1, "type=0"
        Print #1, "autoadjust=0"
        Print #1, "soft=1"
        Print #1, "monospace=0"
        Print #1, "align=7" '中央下基準は7
        Print #1, "spacing_x=0"
        Print #1, "spacing_y=0"
        Print #1, "precision=1"
        Print #1, "color=ffffff"
        Print #1, "color2=000000"
        Print #1, "font=MS UI Gothic" 'フォント
       
        Zimaku = Cells(i, 3).Value
       
        k = InStr(1, Zimaku, "\N", 1)
        Do Until k = 0
            If k = 1 Then
                Zimaku = Mid(Zimaku, k + 2)
            Else
                Zimaku = Left(Zimaku, k - 1) + Chr(13) + Chr(10) + Mid(Zimaku, k + 2)
            End If
            k = InStr(1, Zimaku, "\N", 1)
        Loop
       
        k = 1
        ZimakuUNI = ""
        Do While Mid(Zimaku, k, 1) <> ""
            preUNI = Right("0000" + Hex(AscW(Mid(Zimaku, k, 1))), 4)
            ZimakuUNI = ZimakuUNI + Right(preUNI, 2) + Left(preUNI, 2)
            k = k + 1
        Loop
        Print #1, "text=" + ZimakuUNI + String(4 * 1024 - Len(ZimakuUNI), "0")
       
        Print #1, "[" + Mid(Str(j), 2) + ".1]"
        Print #1, "_name=標準描画"
        Print #1, "X=0.0"
        Print #1, "Y=0.0"
        Print #1, "Z=0.0"
        Print #1, "拡大率=100.00"
        Print #1, "透明度=0.0"
        Print #1, "回転=0.00"
        Print #1, "blend=0"
       
        i = i + 1
        j = j + 1
    Loop

    Close #1

    MsgBox "書き出しました"

End Sub