pandocで生成したWordファイルを微調整するVBScript

docfix.vbs

Option Explicit

' Table     https://learn.microsoft.com/en-us/office/vba/api/word.table
' Columns   https://learn.microsoft.com/en-us/office/vba/api/word.columns
' Cell      https://learn.microsoft.com/en-us/office/vba/api/word.cell

' https://learn.microsoft.com/en-us/office/vba/api/word.wdlinestyle
Const wdLineStyleSingle = 1

' https://learn.microsoft.com/en-us/office/vba/api/word.wdunits
Const wdCharacter       = 1

' https://learn.microsoft.com/en-us/office/vba/api/word.wdautofitbehavior
Const wdAutoFitContent  = 1

' https://learn.microsoft.com/en-us/office/vba/api/word.wdcompatibilitymode
Const wdCurrent         = 65535

Sub Main()
    Dim shellObj, pwdStr, argStr
    
    Set shellObj = CreateObject("WScript.Shell")
    pwdStr = shellObj.CurrentDirectory
    If Right(pwdStr, 1) = "\" Then
        pwdStr = Left(pwdStr, Len(pwdStr) - 1)
    End If
    
    For Each argStr In Wscript.Arguments
        If InStr(1, argStr, "\") < 1 Then
            argStr = pwdStr & "\" & argStr
        End If
        FixDocx argStr
    Next
    
    Set shellObj = Nothing
End Sub

Sub FixDocx(pathStr)
    On Error Resume Next
    Dim wordObj, docObj
    
    Echo "Processing: " & pathStr
    
    Set wordObj = CreateObject("Word.Application")
    Set docObj = wordObj.Documents.open(pathStr)
    
    FixDocument docObj
    
    Echo "  Saving..."
    docObj.Save
    wordObj.Quit
    
    Set docObj = Nothing
    Set wordObj = Nothing
End Sub

Sub FixDocument(docObj)
    Dim cellObj, numTables, iTable
    numTables = docObj.Tables.Count
    
    Echo "  Disabling compatibility mode..."
    docObj.SetCompatibilityMode wdCurrent
    
    Echo "  Number of tables = " & numTables
    For iTable = 1 To numTables
        Echo "  Processing table " & iTable & " / " & numTables
        FixTable docObj.Tables(iTable)
    Next
End Sub

Sub FixTable(tableObj)
    Dim cellObj, colObj, rangeObj, iCol, numCols
    tableObj.Borders.InsideLineStyle = wdLineStyleSingle
    tableObj.Borders.OutsideLineStyle = wdLineStyleSingle
    
    ' Set table font size
    For Each cellObj In tableObj.Range.Cells
        cellObj.Range.Font.Size = 9
    Next
    
    ' Adjust column width
    numCols = tableObj.Columns.Count
    For iCol = 1 To numCols
        Dim maxLen
        Set colObj = tableObj.Columns(iCol)
        
        ' Determine max text length of the column
        maxLen = 0
        For Each cellObj In colObj.Cells
            Set rangeObj = cellObj.Range 
            rangeObj.MoveEnd wdCharacter, -1 
            If Len(rangeObj.Text) > maxLen Then
                maxLen = Len(rangeObj.Text)
            End If
        Next
        
        ' If the length is short, disable word wrapping.
        If maxLen < 15 Then
            Echo "    Disable word wrapping for column(" & iCol & ")"
            For Each cellObj In colObj.Cells
                cellObj.WordWrap = False
            Next
        End If
    Next
    tableObj.AutoFitBehavior(wdAutoFitContent)
End Sub

Sub Echo(textStr)
    If LCase(Right(WScript.FullName, 11)) = "cscript.exe" Then
        WScript.Echo textStr
    End If
End Sub

Main