Foxtable(狐表)用户栏目专家坐堂 → 请教导出


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

主题:请教导出

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


加好友 发短信
等级:超级版主 帖子:13837 积分:69650 威望:0 精华:0 注册:2016/11/1 14:42:00
  发帖心情 Post By:2016/11/2 12:25:00 [显示全部帖子]

Dim bt As String = "导出表"
Dim tbtable As Table = e.Form.Controls("Table1").Table


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


Dim App As New MSExcel.Application
try
    app.DisplayAlerts = False
    Dim Wb As MSExcel.WorkBook = App.WorkBooks.Open(dlg.FileName)
    Dim Ws As MSExcel.WorkSheet = Wb.WorkSheets(bt)
    MessageBox.Show(1)
    Dim Rg2 As MSExcel.Range = Ws.Range("A1")  '以这个指定的单元格为基准
    MessageBox.Show(2)
    Ws.Unprotect(Password:="foxtable")
    Rg2.EntireRow.Insert(MSExcel.XlInsertShiftDirection.xlShiftDown)'在基准单元格上面插入一行
    MessageBox.Show(3)
    Dim rgx As MSExcel.Range = ws.Range("A1")
    rgx.value = bt
    rgx.RowHeight = 25
    With Ws.Range("A1").Font
        .Name = "黑体" '字体
        .Size = 12 '字号
        '.Bold = True   '加粗
        '.Italic = True '斜体
        '.ColorIndex = 3'颜色
    End With
   
    rgx.HorizontalAlignment = MSExcel.Constants.xlCenter '水平居中
    Dim Rg1 As MSExcel.Range = Ws.UsedRange
    Dim hs As Integer
    Dim ls As Integer
    hs = Rg1.Rows.Count
    ls = Rg1.Columns.Count
    Dim Rg3 As MSExcel.Range = Ws.Range(Ws.Cells(1,1),Ws.Cells(1,ls))
    App.DisplayAlerts = False '加上此行可禁止弹出合并前的提示
    Rg3.Merge  '合并指定区域的单元格
    Dim rg As MSExcel.Range
    rg = Ws.Range(Ws.Cells(2,1),Ws.Cells(hs,ls))
    With Rg.Borders(MSExcel.XlBordersIndex.xlInsideHorizontal)   '---设置表格内部横线
        .LineStyle = MSExcel.XlLineStyle.xlDot
        .Weight = MSExcel.XlBorderWeight.xlHairline
        .ColorIndex = 1
    End With
    With Rg.Borders(MSExcel.XlBordersIndex.xlInsideVertical)   '---设置表格内部竖线
        .LineStyle = MSExcel.XlLineStyle.xlDot
        .Weight = MSExcel.XlBorderWeight.xlHairline
        .ColorIndex = 1
    End With
   
   
    With Rg.Borders(MSExcel.XlBordersIndex.xlEdgeTop)   '----表格上边线
        .LineStyle = MSExcel.XlLineStyle.xlDouble
        .Weight = MSExcel.XlBorderWeight.xlThick
        .ColorIndex = 1
    End With
   
    With Rg.Borders(MSExcel.XlBordersIndex.xlEdgeBottom)  '--表格下边线--
        .LineStyle = MSExcel.XlLineStyle.xlDouble
        .Weight = MSExcel.XlBorderWeight.xlThick
        .ColorIndex = 1
    End With
   
    With Rg.Borders(MSExcel.XlBordersIndex.xlEdgeLeft)   '---表格左边线
        .LineStyle = MSExcel.XlLineStyle.xlContinuous
        .Weight = MSExcel.XlBorderWeight.xlThin
        .ColorIndex = 1
    End With
    With Rg.Borders(MSExcel.XlBordersIndex.xlEdgeRight)  '---表格右边线
        .LineStyle = MSExcel.XlLineStyle.xlContinuous
        .Weight = MSExcel.XlBorderWeight.xlThin
        .ColorIndex = 1
    End With
   
    '-----保护单元格---
    Dim Rg5 As MSExcel.Range = Ws.Range(ws.cells(1,1),ws.cells(1,tbtable.Cols.Count))'指定任意单元格区域
    Ws.Unprotect(Password:="foxtable")'撤销对工作表的保护
    Ws.Cells.Locked = False '解除整个工作表所有单元格的锁定
    Rg5.Locked = True'锁定指定的单元格
    Ws.Protect(Password:="foxtable", AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True)
    Wb.Save
    App.quit
   
   
    MessageBox.Show("导出完毕!","提示",MessageBoxButtons.OK,MessageBoxIcon.Information)
   
catch ex As exception
    msgbox(ex.message)
    app.quit
End try


 回到顶部