Foxtable(狐表)用户栏目专家坐堂 → XLS模版引用问题


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

主题:XLS模版引用问题

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


加好友 发短信
等级:一尾狐 帖子:488 积分:3358 威望:0 精华:0 注册:2013/4/17 21:14:00
XLS模版引用问题  发帖心情 Post By:2014/1/22 22:40:00 [只看该作者]

从狐表导出XLS
引用已做好的XLS模版,算是做到了,
但导出效果是分別开了新的工作薄來保存

想做到以模号以分页來保存在一个工作薄里

求教

在进度 表 点击"开单"
导出模号並分別存在各页面去
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:石仓.zip

这是想要导出后的效果
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:想要的效果.xls




[此贴子已经被作者于2014-1-24 12:19:46编辑过]

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


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

 呃,这个问题,上次不是跟你说过了么?

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


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

 如果你要用模板,是无法做到这个效果的,模板生成的,都是能是一个表。

 你必须自己一个值一个值的往excel表里写值

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


加好友 发短信
等级:一尾狐 帖子:488 积分:3358 威望:0 精华:0 注册:2013/4/17 21:14:00
  发帖心情 Post By:2014/1/22 22:56:00 [只看该作者]

上次的解決了,今次是引用已做的模版,想不出來
试了半天都出錯
[此贴子已经被作者于2014-1-22 22:56:20编辑过]

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


加好友 发短信
等级:一尾狐 帖子:488 积分:3358 威望:0 精华:0 注册:2013/4/17 21:14:00
  发帖心情 Post By:2014/1/22 22:59:00 [只看该作者]

因为实际的模版很复杂
用代码去写会是很恐怖

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


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

 哎呀,对vba不熟悉……图片点击可在新窗口打开查看 用下面的代码,测试有效

Dim nams As List(Of String)
nams = DataTables("进度").GetValues("模号")

Dim App As New MSExcel.Application
Dim bname As String = ProjectPath & "开单\总报表.xls"
Dim Wb As MSExcel.WorkBook = App.WorkBooks.Add
Wb.WorkSheets(3).delete
Wb.WorkSheets(2).delete
Dim ws As MSExcel.WorkSheet = Wb.WorkSheets(1)
For Each nam As String In nams
    If nam <> "" Then '----姓名不是空
        Dim Book As New XLS.Book ( ProjectPath & "工作集群\test.xls" )
        Dim sheet As XLS.Sheet = Book.Sheets(0)
        For Each dr3 As DataRow In DataTables("进度").Select("模号 = '" & nam & "'")
            sheet(5,4).value = dr3("模号")
            sheet(1,24).value = dr3("客CODE")
        Next
        Book.Build()
        Dim fl As String = ProjectPath & "开单\" & nam & ".xls"
        Book.Save(fl) '保存工作簿
        
        Dim Wb_temp As MSExcel.WorkBook = App.WorkBooks.Open(fl)
        Dim Ws_temp As MSExcel.WorkSheet = wb_temp.WorkSheets(1)
        Ws_temp.name = nam
        Ws_temp.Copy(System.Reflection.Missing.Value, ws)
        wb_temp.close(False, System.Reflection.Missing.Value, System.Reflection.Missing.Value)
    End If
Next
ws.delete
FileSys.DeleteFile(bname)
Wb.saveas(bname)
App.Quit

Dim Proc As New Process '打开工作簿
Proc.File = bname
Proc.Start()

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


加好友 发短信
等级:一尾狐 帖子:488 积分:3358 威望:0 精华:0 注册:2013/4/17 21:14:00
  发帖心情 Post By:2014/1/23 0:23:00 [只看该作者]

真的成功了,先感谢小甜甜
其實到现时我仍未太弄清 XLS.Book 和 MSExcel.WorkBook 的用法
在帮助文档找到相应教程了

[此贴子已经被作者于2014-1-23 0:45:02编辑过]

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


加好友 发短信
等级:一尾狐 帖子:488 积分:3358 威望:0 精华:0 注册:2013/4/17 21:14:00
CSV格式及中文字乱码问题  发帖心情 Post By:2014/1/23 16:44:00 [只看该作者]

我在当中加入了 插图代码
结果出现这样的错误

 

 
此主题相关图片如下:bug1.jpg
按此在新窗口浏览图片


但仍能成功將图片插入XLS

代码如下:

        Dim Book As New XLS.Book ( ProjectPath & "Attachments\ADV起版单.xls" )
        Dim sheet As XLS.Sheet '= Book.Sheets(0)
       
        Sheet = Book.Sheets(0)
       
        For Each dr3 As DataRow In DataTables("进度").Select("模号 = '" & nam & "'")
            sheet(5,4).value = dr3("模号")
            sheet(1,24).value = dr3("客CODE")
            Sheet(9, 3).Value = New XLS.Picture(GetImage( dr3("图片IP") & "\" & dr3("图库模号") & ".jpg" ))
           
        Next
        Book.Build()
       
        Dim fl As String = ProjectPath & "开单\" & nam & ".xls"
        Book.Save(fl) '保存工作簿


如果把Book.Build()写在上面

        Dim Book As New XLS.Book ( ProjectPath & "Attachments\ADV起版单.xls" )
        Dim sheet As XLS.Sheet '= Book.Sheets(0)
        Book.Build()
        Sheet = Book.Sheets(0)
       
        For Each dr3 As DataRow In DataTables("进度").Select("模号 = '" & nam & "'")
            sheet(5,4).value = dr3("模号")
            sheet(1,24).value = dr3("客CODE")
           Sheet(9, 3).Value = New XLS.Picture(GetImage( dr3("图片IP") & "\" & dr3("图库模号") & ".jpg" ))
        Next
               
        Dim fl As String = ProjectPath & "开单\" & nam & ".xls"
        Book.Save(fl) '保存工作簿

这样就不出现错误

但 模号 和客CODE就失效,赋值失败.

要如何解決??

[此贴子已经被作者于2014-1-23 16:44:34编辑过]

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


加好友 发短信
等级:贵宾 帖子:35433 积分:178524 威望:0 精华:3 注册:2013/3/30 16:36:00
  发帖心情 Post By:2014/1/23 16:46:00 [只看该作者]

出现什么错误?

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


加好友 发短信
等级:七尾狐 帖子:1731 积分:11255 威望:0 精华:0 注册:2011/12/15 22:06:00
  发帖心情 Post By:2014/1/23 17:05:00 [只看该作者]

参考下面数组的输出方式,效率快很多


Dim xlApp As New MSExcel.Application

'xlApp.Visible = True

xlapp.ScreenUpdating = False

Dim wbNew As MSExcel.Workbook 

Dim wsNew As MSExcel.WorkSheet

Dim rng As MSExcel.range

’try

    For Each strPLID As String In lstPLID

        ws.copy (after:= wbNew.worksheets(wbnew.worksheets.count)) 'Copy 模板

        wsNew = xlApp.activeworkbook.activesheet '获取当前Copy模板 ,这两行好像可以合并一行

        Dim n As Integer ' 定义你要输出的行数

        If n = 0 Then Continue For

        Dim arr(0 To n - 1,0 To 5) '定义个数组

        For IntA = 0 To n - 1

            Dim dr As DataRow = lstdr(IntA)

            arr(IntA,0) = 

            arr(IntA,1) = 

            arr(IntA,2) = 

            arr(IntA,3) = 

            arr(IntA,4) = 

            arr(IntA,5) = 

        Next

        wsNew.range("A15").resize(n,ubound(arr,2) + 1).value = arr '比你一行行块10-100倍,行数越多效率越高

    Next

    xlapp.DisplayAlerts = False

    Dim str As String = '保存的文件名

    wbNew.worksheets(1).delete

    wbNew.saveas(strFileGen & str)

    wb.close

    xlapp.DisplayAlerts = True

    xlapp.ScreenUpdating = True

    xlapp.visible = True

[此贴子已经被作者于2014-1-23 17:05:11编辑过]

 回到顶部
总数 21 1 2 3 下一页