求助，如何导出表结构的代码 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

用你的代码测试,一个提示找不到日期控件,第二个,增加了一个空行以及,相同列名合并了.

以下是引用blackzhu在2012-1-15 8:39:00的发言：
用你的代码测试,一个提示找不到日期控件,第二个,增加了一个空行以及,相同列名合并了.

自己增加一个“表名称”和“日期”控件，再试试。

不用vba，纯狐表帮助中的代码：导出Exce（多表头三层）

Dim n,cn As Integer
Dim b1 As String
Dim Book As New XLS.Book(ProjectPath & "test.xls")
Dim Sheet As XLS.Sheet = Book.Sheets(0)
Dim Style As XLS.Style = Book.NewStyle()

Style.AlignHorz = XLS.AlignHorzEnum.Center
Style.AlignVert = XLS.AlignVertEnum.Center

For Each dc As Col In Tables("表A").Cols
    If cn = 0
        cn = dc.Name.split("_").length
    ElseIf cn < dc.Name.split("_").length
        cn = dc.Name.split("_").length    ' 最大层次
    End If

For Each dc As Col In Tables("表A").Cols
    For ii As Integer = 0 To dc.Name.split("_").length-1
        b1 = b1 & dc.Name.split("_")(ii) & "_"
        Sheet(ii+1,n+1).Value = dc.name.split("_")(ii)
        Sheet(ii+1,n+1).Style = Style                       ' 字体居中
    Next

If dc.Name.split("_").length > 1

    If dc.Name.split("_").length = 1
        Sheet.MergeCell(1,n+1,cn,1) ' (0,n,cn,n)
    ElseIf dc.Name.split("_").length = 2
        Sheet.MergeCell(2,n+1,cn-1,1)
    End If
    If b1.split("_")(0) = dc.name.split("_")(0)
        Sheet.MergeCell(1,n,1,2)
    End If

End If

    n = n + 1
    b1 = ""
Next
sheet(0,1).Value = "你喜欢的表名"
Sheet.MergeCell(0,1,1,Tables("表A").Cols.Count)

sheet(0,1).Style = Style
Book.Save(ProjectPath & "test.xls")

Dim Proc As New Process
Proc.File = ProjectPath & "test.xls"
Proc.Start()

[此贴子已经被作者于2012-1-16 14:40:17编辑过]

还贴，加精华。

以下是引用狐狸爸爸在2012-1-16 15:49:00的发言：
还贴，加精华。

哈哈，这个精华要撤销的。等我改进一下····

呵呵，这个比33楼的要强一些，应适合任意当前表的导出，不论有没有多层表头，但是只限制三层以内的表头，三层以上会有点问题的（一般三层够用吧）。另外数据行的导出省略了。纯狐表帮助中的代码

下载信息 [文件大小：下载次数： ]
点击浏览该文件:导出多层表头的excel.rar

[此贴子已经被作者于2012-1-16 19:22:33编辑过]

不错,我就写不出这样的代码来.

学习。只是有些复杂，如果仅导出可见列的话又要加五六行代码。

我来个变态方法

格式设置没有写，大家都懂的。

Dim title As String = "变态方法能加精吗 (:_"
Dim t As Table = CurrentTable
With t.DataTable
    For Each c As Col In t.Cols
        .DataCols(c.Name).Caption = title & c.Name
    Next
    .BuildHeader()
    t.SaveExcel(ProjectPath & "test.xls",t.Name)
    For Each c As Col In t.Cols
        .DataCols(c.Name).Caption = c.Name
    Next
    .BuildHeader()
End With

再优化一下变态代码，下面代码考虑了原来列中设置的标题。

Dim title As String = "变态方法能加精吗 (:_"
Dim t As Table = CurrentTable
With t.DataTable
    For Each c As Col In t.Cols
        .DataCols(c.Name).Caption = title & c.Caption
    Next
    .BuildHeader()
    t.SaveExcel(ProjectPath & "test.xls",t.Name)
    For Each c As Col In t.Cols
        .DataCols(c.Name).Caption = c.Caption.Replace(title,"")
    Next
    .BuildHeader()
End With

主题：求助，如何导出表结构的代码