Excel 表格转 Markdown

Question

我一直在寻找一个简单的宏来将当前选定的 Excel 表格转换为 Markdown，这样我就可以将表格粘贴到我的 Azure DevOps 拉取请求中。

我偶然发现了一堆像this one或this one这样的线程，但这些线程实际上都没有提供宏。

Answer 1

我最终在 ChatGPT 的帮助下生成了一个。

这是宏：

Public Sub CopyTableMarkdown()
    Dim tbl As ListObject
    Dim headerName As String, colLength As Integer
    Dim tableHeadLine As String, tableDelimiter As String
    Dim markdown As String, markdownBody As String
    
    Set tbl = GetTable()
    If tbl Is Nothing Then
        MsgBox "Please select a cell within a table.", vbExclamation
        Exit Sub
    End If
    
    ' Initialize table header lines
    tableHeadLine = "| "
    tableDelimiter = "| "
    
    ' Build header line and delimiter
    For Each headerCell In tbl.HeaderRowRange
        headerName = CStr(headerCell.Value)
        colLength = GetColLength(tbl, headerName)
        tableHeadLine = tableHeadLine & PadRight(headerName, colLength, " ") & " | "
        tableDelimiter = tableDelimiter & PadRight("", colLength, "-") & " | "
    Next headerCell
    
    ' Prepare the markdown header
    markdown = tableHeadLine & vbCrLf & tableDelimiter
    
    ' Build the markdown body
    markdownBody = ""
    For Each dataRow In tbl.DataBodyRange.Rows
        markdownBody = markdownBody & "| "
        For Each cell In dataRow.Cells
                
        
            colLength = GetColLength(tbl, cell.ListObject.ListColumns(cell.Column).Name)
            markdownBody = markdownBody & PadRight(CStr(cell.Value), colLength, " ") & " | "
        Next cell
        markdownBody = markdownBody & vbCrLf
    Next dataRow
    
    ' Combine header and body
    markdown = markdown & vbCrLf & markdownBody
    
    CopyText markdown
    
    MsgBox "Markdown copied", vbOKOnly
End Sub

Function GetTable() As ListObject
    On Error Resume Next
    Set GetTable = Selection.ListObject
    On Error GoTo 0
End Function

Function GetColLength(tbl As ListObject, columnName As String) As Integer
    Dim maxLength As Integer, cell As Range, col As ListColumn
    
    On Error Resume Next
    Set col = tbl.ListColumns(columnName)
    On Error GoTo 0
    
    If col Is Nothing Then
        GetColLength = -1 ' Indicate that the column was not found
        Exit Function
    End If
    
    ' Check header length
    maxLength = Len(col.Name)
    
    ' Check each cell in the column
    For Each cell In col.DataBodyRange
        If Len(cell.Value) > maxLength Then
            maxLength = Len(cell.Value)
        End If
    Next cell
    
    GetColLength = maxLength
End Function
Function PadRight(ByVal inputString As String, ByVal totalLength As Integer, ByVal paddingChar As String) As String
    Dim lengthDiff As Integer
    lengthDiff = totalLength - Len(inputString)
    
    If lengthDiff > 0 Then
        PadRight = inputString & String(lengthDiff, paddingChar)
    Else
        PadRight = inputString
    End If
End Function

Sub CopyText(Text As String)
    'VBA Macro using late binding to copy text to clipboard.
    'By Justin Kay, 8/15/2014
    Dim MSForms_DataObject As Object
    Set MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    MSForms_DataObject.SetText Text
    MSForms_DataObject.PutInClipboard
    Set MSForms_DataObject = Nothing
End Sub

使用方法：

1. （如果尚未完成）启用

   Developer

   -tab
2. 将宏放入

   PERSONAL.xlsb

   ，使其全局可用。
3. 将表格格式化为实际的 Excel 表格。
4. 单击该表格中的任意单元格
5. 执行宏。这会将 Markdown 作为文本复制到剪贴板。