WIN10下代码导出出错。WIN7下正常
此主题相关图片如下:代码导出.png
If
FileSys.DirectoryExists("D:\My Documents\Reports") Then ' 目录存在
Else
FileSys.CreateDirectory("D:\My
Documents\Reports") '创建 目录
End If
Dim flg As New
SaveExcelFlags
flg.MergedRanges =
True
Tables("到村").SaveExcel("D:\My
Documents\Reports\到村.xls","到村",flg)
Dim Result As
DialogResult
Dim App As New
MSExcel.Application
Dim Wb As
MSExcel.WorkBook = App.WorkBooks.Open("D:\My Documents\Reports\到村.xls")
Dim Ws As
MSExcel.WorkSheet = Wb.WorkSheets(1)
Dim Rg As
MSExcel.Range = Ws.UsedRange
Rg.Borders.Linestyle
= MSExcel.XlLineStyle.xlContinuous '边框线型
Rg.Borders.Weight
= MSExcel.XlBorderWeight.xlThin '边框粗细
Rg.Borders.ColorIndex
= 1 '边框颜色
Dim M As
MSExcel.Range = Ws.Cells
M.EntireColumn.AutoFit '自动调整列宽
M.EntireRow.AutoFit '自动调整行高
App.Visible = True
Wb.Save