Foxtable(狐表)用户栏目专家坐堂 → 请教这复合表头,怎么用vba导出到excel表里


  共有2020人关注过本帖树形打印复制链接

主题:请教这复合表头,怎么用vba导出到excel表里

帅哥哟,离线,有人找我吗?
有点甜
  11楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/5/30 18:06:00 [只看该作者]

要设置样式,认认真真看

 

http://www.foxtable.com/webhelp/scr/2121.htm

 

Dim dt As Table = Tables("横向报表_Table1")
Dim App As New MSExcel.Application
Dim Wb As MSExcel.WorkBook = App.WorkBooks.add
Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
ws.name = "test"
Dim idx As Integer = 0
For c As Integer = 0 To dt.Cols.Count -1 '添加列标题
    Dim c1 = ws.cells(1, c+1)
    Dim c2 = ws.cells(2, c+1)
    If dt.Cols(c).caption.contains("出入库") Then
        Dim Rg As MSExcel.Range = Ws.Range(c1.address & ":" & ws.cells(1, c+7).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        c1.Value = dt.Cols(c).caption.split("_")(0)
        c2.Value = dt.Cols(c).caption.split("_")(1)
        If idx Mod 2 = 0
            c1.Interior.ColorIndex = 3'单元格填充颜色为红色
            c2.Interior.ColorIndex = 3'单元格填充颜色为红色
        End If
        idx += 1
    ElseIf dt.Cols(c).caption.contains("计") Then
        Dim Rg As MSExcel.Range = Ws.Range(c1.address & ":" & ws.cells(2, c+1).address)
        App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
        Rg.Merge  '合并指定区域的单元格
        c1.Value = dt.Cols(c).caption
        If idx Mod 2 = 0
            rg.Interior.ColorIndex = 3'单元格填充颜色为红色
        End If
        idx += 1
    Else
        Dim ary() = dt.Cols(c).caption.split("_")
        If ary.length = 1 Then
            Dim Rg As MSExcel.Range = Ws.Range(c1.address & ":" & c2.address)
            App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
            Rg.Merge  '合并指定区域的单元格
            c1.Value = ary(0)
        Else
            If idx Mod 2 = 1
                c2.Interior.ColorIndex = 3'单元格填充颜色为红色
            End If
            c2.Value = ary(1)
        End If
    End If
Next
Dim arr(0 To dt.Rows.count-1,0 To dt.Cols.count-1) As Object  '定义二维数组
For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To dt.Cols.Count -1
        arr(r, c) = dt.rows(r)(c)
    Next
Next
Dim Rg2 As MSExcel.Range = Ws.Range("A3:" & ws.cells(dt.Rows.count+2, dt.Cols.count).address)  '定义Excel中写入的区域
Rg2.Value = arr
app.visible = True


 回到顶部
帅哥哟,离线,有人找我吗?
xxfoxtable
  12楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1709 积分:15988 威望:0 精华:0 注册:2017/6/1 23:12:00
  发帖心情 Post By:2018/5/30 18:48:00 [只看该作者]

我看了,可不可以按区域一次填充颜色呢?表头和数据部分都加背景色

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  13楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/5/30 18:55:00 [只看该作者]

以下是引用xxfoxtable在2018/5/30 18:48:00的发言:
我看了,可不可以按区域一次填充颜色呢?表头和数据部分都加背景色

 

看懂代码自己修改。看不懂,重新看vba教程


 回到顶部
帅哥哟,离线,有人找我吗?
xxfoxtable
  14楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1709 积分:15988 威望:0 精华:0 注册:2017/6/1 23:12:00
  发帖心情 Post By:2018/5/30 19:10:00 [只看该作者]

Ws.range(ws.cells(0, 2).address & ":" & ws.cells(33, 9).address).Interior.Color = RGB(192, 255, 192)   老师我这样写对吗?现报错

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  15楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/5/30 21:32:00 [只看该作者]

以下是引用xxfoxtable在2018/5/30 19:10:00的发言:
Ws.range(ws.cells(0, 2).address & ":" & ws.cells(33, 9).address).Interior.Color = RGB(192, 255, 192)   老师我这样写对吗?现报错

 

类似这样的代码。你要把地址你写成动态的(参考11楼)


 回到顶部
帅哥哟,离线,有人找我吗?
xxfoxtable
  16楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1709 积分:15988 威望:0 精华:0 注册:2017/6/1 23:12:00
  发帖心情 Post By:2018/5/30 21:42:00 [只看该作者]

Ws.range(ws.cells(0, 2).address & ":" & ws.cells(33, 9).address).Interior.Color = RGB(192, 255, 192) 

图片点击可在新窗口打开查看此主题相关图片如下:1.png
图片点击可在新窗口打开查看
我一点一点学,先学会加颜色,再研究动态,但这句报错
[此贴子已经被作者于2018/5/30 21:43:51编辑过]

 回到顶部
帅哥哟,离线,有人找我吗?
有点甜
  17楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:版主 帖子:85326 积分:427815 威望:0 精华:5 注册:2012/10/18 22:13:00
  发帖心情 Post By:2018/5/30 21:50:00 [只看该作者]

Ws.range(ws.cells(1, 2).address & ":" & ws.cells(33, 9).address).Interior.Color = RGB(192, 255, 192) 

 回到顶部
帅哥哟,离线,有人找我吗?
xxfoxtable
  18楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:七尾狐 帖子:1709 积分:15988 威望:0 精华:0 注册:2017/6/1 23:12:00
  发帖心情 Post By:2018/6/1 18:17:00 [只看该作者]

For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To dt.Cols.Count -1
        If    val(dt.rows(r)(c))=0
            ws.cells(r+3, c+1).Value = ""
        Else
            ws.cells(r+3, c+1).Value = dt.rows(r)(c)
        End If
    Next
Next
有的备注倒出去了,有的没有倒出去,想不明白是啥问题了

 回到顶部
帅哥,在线噢!
有点蓝
  19楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:107523 积分:546900 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2018/6/1 19:58:00 [只看该作者]

For r As Integer = 0 To dt.Rows.Count - 1 '填入数据
    For c As Integer = 0 To dt.Cols.Count -1
        If  vdt.rows(r).isnull(c)
            ws.cells(r+3, c+1).Value = ""
        Else
            ws.cells(r+3, c+1).Value = dt.rows(r)(c)
        End If
    Next
Next

 回到顶部
总数 19 上一页 1 2