以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  请教:SaveExcel函数保存后其他工作表数据有效性不可用是什么原因  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=114796)

--  作者:zqxzhs
--  发布时间:2018/2/22 17:20:00
--  请教:SaveExcel函数保存后其他工作表数据有效性不可用是什么原因

利用SaveExcel保存到指定工作簿的工作表中时,出现两个问题,请指教:

1.提示文件已经存在是否替换?,能否不让它提示

2.保存后,其他工作表中的数据有效性下拉都失效,如何解决处理呢?

Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg
.Filter= "Excel文件|*.xls" \'设置筛选器
If
dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
     Tables("订单").SaveExcel(dlg.FileName, "订单"
\'保存文件

End
If


--  作者:有点甜
--  发布时间:2018/2/22 17:52:00
--  

1、加上代码

 

dlg.OverwritePrompt = False

 

2、你的excel文件发上来测试一下


--  作者:zqxzhs
--  发布时间:2018/2/22 18:04:00
--  
不导出时,数据表统计里面数据有效性是可以的,导出后,就不能用了。
--  作者:zqxzhs
--  发布时间:2018/2/22 18:04:00
--  
 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:订单.zip


--  作者:有点甜
--  发布时间:2018/2/22 18:18:00
--  

我这样测试:

 

导出一次excel,然后重新设置【有效性】,然后再怎么导出都没问题了。

 

有可能是bug,你先这样处理一下。


--  作者:zqxzhs
--  发布时间:2018/2/23 8:50:00
--  
以下是引用有点甜在2018/2/22 18:18:00的发言:

我这样测试:

 

导出一次excel,然后重新设置【有效性】,然后再怎么导出都没问题了。

 

有可能是bug,你先这样处理一下。

我用的excel2003,只要导出【有效性】就失效了,重设在导出仍然失效。


--  作者:有点甜
--  发布时间:2018/2/23 10:01:00
--  

比较麻烦,这样就必须换一种方式导出了,参考(二维数组导出)

 

on error resume Next
Dim dlg As New SaveFileDialog \'定义一个新的SaveFileDialog
dlg.Filter= "Excel文件|*.xls" \'设置筛选器
If dlg.ShowDialog = DialogResult.Ok Then \'如果用户单击了确定按钮
    Dim dt As Table = Tables("订单")
    Dim App As New MSExcel.Application
    Dim Wb As MSExcel.WorkBook
    If FileSys.FileExists(dlg.FileName) Then
        wb = App.WorkBooks.Open(dlg.FileName)
    Else
        wb = App.WorkBooks.Add
    End If
    Dim arr(0 To dt.Rows.count,0 To dt.Cols.count-1) As Object  \'定义二维数组
    Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets("订单")
    If ws Is Nothing Then
        ws = Wb.WorkSheets.add
        ws.name = "订单"
    Else
        Ws.UsedRange.clear
    End If
    For c As Integer = 0 To dt.Cols.Count -1 \'添加列标题
        arr(0,c) = dt.Cols(c).Name
    Next
    For r As Integer = 0 To dt.Rows.Count - 1 \'填入数据
        For c As Integer = 0 To dt.Cols.Count -1
            arr(r+1, c) = dt.rows(r)(c)
        Next
    Next
    Dim Rg2 As MSExcel.Range = Ws.Range("A1:" & ws.cells(dt.Rows.count+1, dt.Cols.count).address)  \'定义Excel中写入的区域
    Rg2.Value = arr
    app.visible = True
End If


--  作者:zqxzhs
--  发布时间:2018/2/23 10:28:00
--  
谢版主,这办法很好,二维数组我不是很明白,我学学,辛苦了。