以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  XLS模版引用问题  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=45347)
--  作者：realredred
--  发布时间：2014/1/22 22:40:00
--  XLS模版引用问题
从狐表导出XLS
引用已做好的XLS模版,算是做到了,
但导出效果是分別开了新的工作薄來保存

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

求教

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

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




[此贴子已经被作者于2014-1-24 12:19:46编辑过]
--  作者：有点甜
--  发布时间：2014/1/22 22:54:00
--  
 呃，这个问题，上次不是跟你说过了么？
--  作者：有点甜
--  发布时间：2014/1/22 22:56:00
--  
 如果你要用模板，是无法做到这个效果的，模板生成的，都是能是一个表。

 你必须自己一个值一个值的往excel表里写值
--  作者：realredred
--  发布时间：2014/1/22 22:56:00
--  
上次的解決了,今次是引用已做的模版,想不出來
试了半天都出錯
[此贴子已经被作者于2014-1-22 22:56:20编辑过]
--  作者：realredred
--  发布时间：2014/1/22 22:59:00
--  
因为实际的模版很复杂
用代码去写会是很恐怖
--  作者：有点甜
--  发布时间：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
--  发布时间：2014/1/23 0:23:00
--  
真的成功了,先感谢小甜甜
其實到现时我仍未太弄清 XLS.Book 和 MSExcel.WorkBook 的用法
在帮助文档找到相应教程了

[此贴子已经被作者于2014-1-23 0:45:02编辑过]
--  作者：realredred
--  发布时间：2014/1/23 16:44:00
--  CSV格式及中文字乱码问题

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

 

 
此主题相关图片如下：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
--  发布时间：2014/1/23 16:46:00
--  
出现什么错误?
--  作者：jspta
--  发布时间：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编辑过]