Attribute VB_Name = "TexcelCls"
Private tIndentChr As String

Sub CallTexcel()
    
    TexcelForm.Show
    
End Sub

' TeXのエスケープ文字をエスケープします
Function EscapeForTex(text As String)

    Dim res As String
    
    res = text
    res = Replace(res, "\", "\\")
    res = Replace(res, "_", "\_")
    res = Replace(res, "#", "\#")
    res = Replace(res, "$", "\$")
    res = Replace(res, "&", "\&")
    res = Replace(res, "%", "\%")
    res = Replace(res, "{", "\{")
    res = Replace(res, "}", "\}")
    
    EscapeForTex = res
    
End Function

' インデント文字をN段分出力します
Private Function Indent(N As Integer)

    Dim i As Integer
    Dim res As String
    
    res = ""
    
    For i = 1 To N
        res = res & tIndentChr
    Next i
    
    Indent = res

End Function

' ExcelのAlignのコードに対応するTeXのAlign文字を出力します
Private Function GetAlign(align As Integer)

    Dim chr As String
    
    Select Case align
        Case -4108:
            chr = "c"
        Case -4131:
            chr = "l"
        Case -4152:
            chr = "r"
        Case Else:
            chr = "c"
    End Select
    
    GetAlign = chr
    
End Function

' hlineまたはclineを出力します
Private Function GetHline(base_r As Long, base_c As Long, row As Long, cols As Long, Optional edge As Integer = xlEdgeBottom)

    Dim allline_flag As Boolean
    
    
    Dim hline() As Integer
    ReDim hline(cols + 1)
    hline(cols + 1) = xlLineStyleNone
    
    If Cells(base_r + row - 1, base_c).Borders(edge).LineStyle <> xlLineStyleNone Then
        allline_flag = True
    Else
        allline_flag = False
    End If
    
    For i = 1 To cols
        hline(i) = Cells(base_r + row - 1, base_c + i - 1).Borders(edge).LineStyle
        If (i > 1) And (hline(i - 1) <> hline(i)) Then
            allline_flag = False
        End If
    Next i
    
    Dim hline_str As String
    hline_str = ""
    
    If allline_flag Then
        hline_str = "\hline"
    Else
        Dim linestate As Integer
        linestate = 0
        For i = 1 To cols + 1
            If linestate > 0 And hline(i) = xlLineStyleNone Then
                hline_str = hline_str & "\cline{" & linestate & "-" & i - 1 & "}"
            ElseIf linestate = 0 And hline(i) <> xlLineStyleNone Then
                linestate = i
            End If
        Next i
    End If
    
    GetHline = " " & hline_str
    
End Function

' 本体です
' table : 表となるセルの範囲
' aCaption : キャプション
' aLabel : ラベル
' aPos : 位置を示すタグ(h, t, b, p)
' aDoubleColumn : table / table*
' aScaleBox : 拡大率
' aIndent : インデントの文字
Public Function Excel2Tex( _
        table As Range, _
        Optional aCaption As String = "", _
        Optional aLabel As String = "", _
        Optional aPos As String = "h", _
        Optional aDoubleColumn As Boolean = False, _
        Optional aScaleBox As Double = 1#, _
        Optional aIndent As String = "")

    Dim rows, cols, i, j As Integer
    
    Dim result(2) As Variant
    Dim textext As String   ' TeX出力テキスト
    Dim preamble As String  ' プリアンブル
    Dim tmpchr As String
    Dim tablecommand As String
    
    ' 入力チェック
    If Not (aPos = "h" Or aPos = "t" Or aPos = "b" Or aPos = "p") Then
        result(0) = "Error in 'pos'"
        Excel2Tex = result
        Exit Function
    End If
    
    If aIndent = "" Then
        aIndent = chr(9)
    End If
    tIndentChr = aIndent
    
    Dim multirow_en As Boolean
    multirow_en = False
    
    rows = table.rows.Count
    cols = table.Columns.Count
    
    Dim OpCell As Object    '操作対象のセル
    Dim base_r, base_c As Long
    
    ' tableのタグ指定
    If aDoubleColumn Then
        tablecommand = "table*"
    Else
        tablecommand = "table"
    End If
    
    preamble = ""
    
    ' tableタグ スタート
    textext = "\begin{" & tablecommand & "}[" & aPos & "]" & vbCrLf
    textext = textext & Indent(1) & "\centering" & vbCrLf
    textext = textext & Indent(1) & "\caption{" & aCaption & "}" & vbCrLf
    textext = textext & Indent(1) & "\label{" & aLabel & "}" & vbCrLf
    
    If aScaleBox <> 1# Then
        textext = textext & Indent(1) & "\scalebox{" & aScaleBox & "}{" & vbCrLf
    End If
    
    ' 表の設定: 1列目で判定
    textext = textext & Indent(1) & "\begin{tabular}{"
    
    base_r = table(1).row
    base_c = table(1).Column
    
    ' 左罫線の指定
    tmpchr = ""
    For i = 1 To rows
        If Cells(base_r + i - 1, base_c).Borders(xlEdgeLeft).LineStyle <> xlLineStyleNone Then
            tmpchr = "|"
        End If
    Next i
    textext = textext & tmpchr
    
    ' 全体的なセルのAlign
    For i = 1 To cols
        Set OpCell = Cells(base_r, base_c + i - 1)
        textext = textext & GetAlign(OpCell.HorizontalAlignment)
        
        tmpchr = ""
        For j = 1 To rows
            If Cells(base_r + j - 1, base_c + i - 1).Borders(xlEdgeRight).LineStyle <> xlLineStyleNone Then
                tmpchr = "|"
            End If
        Next j
        textext = textext & tmpchr
    Next i
    textext = textext & "}"
    
    ' 上罫線の指定
    textext = textext & GetHline((base_r), (base_c), 1, (cols), xlEdgeTop)
    textext = textext & vbCrLf
    
    Dim FirstColumnFlag As Boolean
    
    For i = 1 To rows
        FirstColumnFlag = True
        textext = textext & Indent(2) & splitchr
        For j = 1 To cols
            Set OpCell = Cells(base_r + i - 1, base_c + j - 1)
            
            ' セルの結合の判定
            If OpCell.MergeCells Then
                Dim MergeAreaColumns, MergeAreaRows As Integer
                Dim MergeAreaText, MergeAreaAlign As String
                MergeAreaColumns = OpCell.MergeArea.Columns.Count
                MergeAreaRows = OpCell.MergeArea.rows.Count
                MergeAreaText = EscapeForTex(OpCell.MergeArea.Cells(1, 1).text)
                ' セルのAlignの設定
                MergeAreaAlign = ""
                If OpCell.MergeArea.Cells(1, 1).Borders(xlEdgeLeft).LineStyle <> xlLineStyleNone Then
                    MergeAreaAlign = MergeAreaAlign & "|"
                End If
                MergeAreaAlign = MergeAreaAlign & GetAlign(OpCell.HorizontalAlignment)
                If OpCell.MergeArea.Cells(1, MergeAreaColumns).Borders(xlEdgeRight).LineStyle <> xlLineStyleNone Then
                    MergeAreaAlign = MergeAreaAlign & "|"
                End If
                If OpCell.Column = OpCell.MergeArea.Cells(1, MergeAreaColumns).Column Then
                    If Not FirstColumnFlag Then
                        textext = textext & " & "
                    End If
                    If MergeAreaRows > 1 Then
                        If OpCell.row = OpCell.MergeArea.Cells(1, mergeareacolmuns).row Then
                            multirow_en = True
                            If MergeAreaColumns > 1 Then
                                textext = textext & "\multicolumn{" & MergeAreaColumns & "}{" & MergeAreaAlign & "}{\multirow{" & MergeAreaRows & "}{*}{" & MergeAreaText & "}}"
                            Else
                                textext = textext & "\multirow{" & MergeAreaRows & "}{*}{" & MergeAreaText & "}"
                            End If
                        Else
                            If MergeAreaColumns > 1 Then
                                textext = textext & "\multicolumn{" & MergeAreaColumns & "}{" & MergeAreaAlign & "}{~}"
                            Else
                                textext = textext & " "
                            End If
                        End If
                    Else
                        textext = textext & "\multicolumn{" & MergeAreaColumns & "}{" & MergeAreaAlign & "}{" & MergeAreaText & "}"
                    End If
                Else
                    GoTo ContinueJ
                End If
            Else
                If Not FirstColumnFlag Then
                    textext = textext & " & "
                End If
                textext = textext & EscapeForTex(OpCell.text)
            End If
            
            
            FirstColumnFlag = False
ContinueJ:
        Next j
        textext = textext & " \\"
        
        ' 下罫線の判定
        textext = textext & GetHline((base_r), (base_c), (i), (cols))
        
        textext = textext & vbCrLf
    Next i
    
    textext = textext & Indent(1) & "\end{tabular}" & vbCrLf
    If aScaleBox <> 1# Then
        textext = textext & Indent(1) & "}" & vbCrLf
    End If
    textext = textext & "\end{" & tablecommand & "}"
    
    If multirow_en Then
        preamble = preamble & "\usepackage{multirow}" & vbCrLf
    End If
    
    result(0) = textext
    result(1) = preamble
    result(2) = "Reserved"
    
    Excel2Tex = result

End Function

' ワークシートから呼び出すときはこちらです
Public Function Texcel( _
        Area As Range, _
        Optional Caption As String = "", _
        Optional Label As String = "", _
        Optional Pos As String = "h", _
        Optional DoubleColumn As Boolean = False, _
        Optional Zoom As Double = 1#, _
        Optional Indent As Integer = 1) As String
        
    Dim res As Variant
    Dim IndentChr As String
    
    Select Case Indent
        Case 1
            IndentChr = chr(9)
        Case 2
            IndentChr = "  "
        Case 3
            IndentChr = "    "
        Case Else
            IndentChr = chr(9)
    End Select
    
    res = Excel2Tex(Area, Caption, Label, Pos, DoubleColumn, Zoom, IndentChr)
    
    Texcel = res(0)

End Function