VB 通过指定Excel模板文件进行另存为新文件操作

发布时间：2020-12-17 08:16:37 所属栏目：百科来源：网络整理

导读：Private Sub cmdExport_Click() Dim strTemplateFile As String Dim strFileName As String Dim FSO As New FileSystemObject Dim excelApp As Excel.Application Dim excelBook As Excel.Workbook Dim excelSheet As Excel.Worksheet Dim lngLineNo As Long

Private Sub cmdExport_Click() Dim strTemplateFile As String Dim strFileName As String Dim FSO As New FileSystemObject Dim excelApp As Excel.Application Dim excelBook As Excel.Workbook Dim excelSheet As Excel.Worksheet Dim lngLineNo As Long Dim i As Long On Error GoTo ErrHandle strTemplateFile = gStrXlt & "模板文件名.xls" If Not FSO.FileExists(strTemplateFile) Then MsgBox "模板文件不存在",vbCritical,Me.Caption Exit Sub End If strFileName = gStrOther & "新文件名" & Format(Date,"YYYYMMDD") & ".xls" If FSO.FileExists(strFileName) Then FSO.DeleteFile strFileName End If Set excelApp = CreateObject("Excel.Application") Set excelBook = excelApp.Workbooks.Open(strTemplateFile) Set excelSheet = excelBook.Worksheets(1) excelApp.Visible = False excelApp.DisplayAlerts = False '禁止Excel提示 excelApp.Columns("A:L").NumberFormatLocal = "@" '设置成文本格式 With prg .Max = lvData.ListItems.Count .Min = 0 .Value = 0 End With lngLineNo = 4 '从第四行开始写 For i = 1 To lvData.ListItems.Count excelSheet.Cells(lngLineNo,1) = lvData.ListItems(i).SubItems(1) excelSheet.Cells(lngLineNo,2) = lvData.ListItems(i).SubItems(2) excelSheet.Cells(lngLineNo,3) = lvData.ListItems(i).SubItems(3) excelSheet.Cells(lngLineNo,4) = lvData.ListItems(i).SubItems(4) excelSheet.Cells(lngLineNo,5) = lvData.ListItems(i).SubItems(5) lngLineNo = lngLineNo + 1 If prg.Value < prg.Max Then prg.Value = prg.Value + 1 End If DoEvents Next prg.Value = prg.Max With excelSheet .Range(.Cells(1,1),Cells(lvData.ListItems.Count + 3,5)).Borders.LineStyle = xlContinuous .Range(.Cells(1,5)).Font.Size = 9 End With excelBook.Saved = True excelBook.SaveAs strFileName '关闭Excel进程 excelBook.Close excelApp.Quit Set excelBook = Nothing Set excelApp = Nothing MsgBox "导出完毕!" & vbCrLf & "文件路径:" & strFileName,vbInformation,Me.Caption On Error GoTo 0 Exit Sub ErrHandle: Call gErrList("frmFenQiQiShuRpt.cmdExport_Click",Err.Description,Err.Number,True) End Sub

（编辑：李大同）

【声明】本站内容均来自网络，其相关言论仅代表作者个人观点，不代表本站立场。若无意侵犯到您的权利，请及时与联系站长删除相关内容!