专家坐堂-XLS模版引用问题Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.net/bbs/index.asp)
--  专家坐堂  (http://foxtable.net/bbs/list.asp?boardid=2)
----  XLS模版引用问题  (http://foxtable.net/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编辑过]