Sub ExcelWaveSolderModel(ByVal LS As ListView)Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
'劃線xlSheet.Range("a2:q3").Select
With xlApp.Selection
    .HorizontalAlignment = xlCenter
    .WrapText = True
    .Font.Size = 10
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlThin
End With
xlSheet.Range("a4:q21").Select
With xlApp.Selection
   .HorizontalAlignment = xlCenter
    .WrapText = True
    .Font.Size = 12
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlThin
End With
With xlSheet
'LeadFree圖標
'列高
.Range("a2:q2").RowHeight = 36.75'No.
.Range("A:A").ColumnWidth = 2.5
.Range("a2").Value = "No"
'PN
.Range("B:B").ColumnWidth = 15.75
.Range("b2").Value = "料號"
'Type.Range("c:c").ColumnWidth = 11.5.Range("c2").Value = "Model"'SolderPot Temperature
.Range("d:d").ColumnWidth = 8.5
.Range("d2").Value = "SolderPot Temperature"
.Range("d3").Value = "±5(℃)"'LowPre-Heater 1
.Range("e:e").ColumnWidth = 5.25
.Range("e2").Value = "LowPre-Heater 1"
.Range("e3").Value = "±5(℃)"
'LowPre-Heater 2
.Range("f:f").ColumnWidth = 5.25
.Range("f2").Value = "LowPre-Heater 2"
.Range("f3").Value = "±5(℃)"
'LowPre-Heater 3
.Range("g:g").ColumnWidth = 5.25
.Range("g2").Value = "LowPre-Heater 3"
.Range("g3").Value = "±5(℃)"
'LowPre-Heater 4
.Range("h:h").ColumnWidth = 5.25
.Range("h2").Value = "LowPre-Heater 4"
.Range("h3").Value = "±5(℃)"
'UpPre-Heater 1
.Range("i:i").ColumnWidth = 5
.Range("i2").Value = "UpPre-Heater 1"
.Range("i3").Value = "±5(℃)"
'UpPre-Heater 2
.Range("j:j").ColumnWidth = 5
.Range("j2").Value = "UpPre-Heater 2"
.Range("j3").Value = "±5(℃)"
'UpPre-Heater 3
.Range("k:k").ColumnWidth = 5
.Range("k2").Value = "UpPre-Heater 3"
.Range("k3").Value = "±5(℃)"
'傳送帶速度
.Range("l:l").ColumnWidth = 5.88.Range("l2").Value = "傳送帶速度".Range("l3").Value = "m/min"'軌道寬度.Range("m:m").ColumnWidth = 4.5.Range("m2").Value = "軌道寬度".Range("m3").Value = "±1mm"'LeadClearance.Range("n:n").ColumnWidth = 6.Range("n2").Value = "LeadClearance".Range("n3").Value = "±0.5mm"'ContourWaveHeight.Range("o:o").ColumnWidth = 8.38.Range("o2").Value = "ContourWaveHeight".Range("o3").Value = "±0.1mm"'ChipWaveHeight.Range("p:p").ColumnWidth = 7.Range("p2").Value = "ChipWaveHeight".Range("p3").Value = "±0.5mm"'備註
.Range("q:q").ColumnWidth = 13
.Range("q2").Value = "備註"
'工程師確認
.Range("o22").Value = "工程師確認:"
'Re
.Range("a23").Value = "Re:"
.Range("a24").Value = "1:"
.Range("a24").Font.Size = 9
.Range("a24:q24").MergeCells = True
.Range("a25").Value = "2:"
.Range("a25").Font.Size = 9
.Range("a25:q25").MergeCells = True
.Range("a26").Value = "3:"
.Range("a26").Font.Size = 9
.Range("a26:q26").MergeCells = True
.Range("a27").Value = "4:"
.Range("a27").Font.Size = 9
.Range("a27:q27").MergeCells = True
End With'Write Data Into Excel from Listview1
    For i = 1 To PrintNumber        xlSheet.Cells(i + 3, 1) = i        xlSheet.Cells(i + 3, 2) = LS.ListItems(i).SubItems(6)        xlSheet.Cells(i + 3, 3) = LS.ListItems(i).SubItems(5)        xlSheet.Cells(i + 3, 4) = LS.ListItems(i).SubItems(8)        xlSheet.Cells(i + 3, 5) = LS.ListItems(i).SubItems(9)        xlSheet.Cells(i + 3, 6) = LS.ListItems(i).SubItems(10)        xlSheet.Cells(i + 3, 7) = LS.ListItems(i).SubItems(11)        xlSheet.Cells(i + 3, 8) = LS.ListItems(i).SubItems(12)        xlSheet.Cells(i + 3, 9) = LS.ListItems(i).SubItems(13)        xlSheet.Cells(i + 3, 10) = LS.ListItems(i).SubItems(14)        xlSheet.Cells(i + 3, 11) = LS.ListItems(i).SubItems(15)        xlSheet.Cells(i + 3, 12) = "'" & Format(LS.ListItems(i).SubItems(16), "0.0")        xlSheet.Cells(i + 3, 13) = "'" & Format(LS.ListItems(i).SubItems(17), "0.0")        xlSheet.Cells(i + 3, 14) = "'" & Format(LS.ListItems(i).SubItems(18), "0.0")        xlSheet.Cells(i + 3, 15) = "'" & Format(LS.ListItems(i).SubItems(19), "0.0")        xlSheet.Cells(i + 3, 16) = "'" & Format(LS.ListItems(i).SubItems(20), "0.0")    Next i'頁面設置With xlSheet.PageSetup.CenterHeader = "&14設定表" & "(" & PrintLine & ")".LeftFooter = "保存期限:一年"'.LeftFooter = "1."
'.LeftFooter = .LeftFooter & vbCrLf & "3. "
'.LeftFooter = .LeftFooter & vbCrLf & "4 . "
'.LeftFooter = .LeftFooter & vbCrLf & "保存期限:一年".RightFooter = "表單編號: " & WSListVersion.LeftMargin = Application.InchesToPoints(0.75).RightMargin = Application.InchesToPoints(0.75).TopMargin = Application.InchesToPoints(1).BottomMargin = Application.InchesToPoints(1).HeaderMargin = Application.InchesToPoints(0.5).FooterMargin = Application.InchesToPoints(0.5).PrintHeadings = False.PrintGridlines = False.PrintComments = xlPrintNoComments'.PrintQuality = 600.CenterHorizontally = False.CenterVertically = False.Orientation = xlLandscape.Draft = False.PaperSize = xlPaperA4.FirstPageNumber = xlAutomatic.Order = xlDownThenOver.BlackAndWhite = False.Zoom = 100.PrintErrors = xlPrintErrorsDisplayedEnd WithAddressStr = xlSheet.PageSetup.CenterHeader
xlApp.ActiveWorkbook.SaveAs (App.Path & "\" & AddressStr)xlApp.Visible = TruexlApp.ActiveWorkbook.ClosexlApp.QuitSet xlSheet = NothingSet xlBook = NothingSet xlApp = NothingEnd Sub
不知道是那些地方代码多余了还是什么问题,导出Excel时特别慢(数据只有10组不到).大家能不能帮忙看看。谢谢
另外,如何通过程序直接打印呢,而不通过Excel,

解决方案 »

  1.   

    取得单元格的数据,直接用printer对象打印
      

  2.   

    一般是MergeCells和for循环耗时比较厉害
    要不就不合并,导出excel之后手工合并.
      

  3.   

    你手工打开Excel,看看这个速度慢不慢?
    最大的耗时并不总是在填充数据的时候。
      

  4.   

    1、楼主分段测一下哪部分代码慢
    2、楼主在导出过程中又设置格式,可以先做一个设置好格式的空文件,
    以后每次导出时都使用这个模板,就不需要再设置格式什么的了
    只需要填写数据
    3、你下面循环中,填写一行的时候,试着这样进行
    将这一行每个单元格的数据用vbTab分隔放到粘贴板中,然后到EXCEL中进行粘贴
    多行的话,每行用vbnewline分隔
    这样比你一个单元格一个单元格地操作要快很多
      

  5.   

    合并还是要先合并的。我试一下(jhone99的方法)主要是在建立格式上耗时。
    sdfkfkd:
    先做好一个空文件,再导入数据?这个如何做呢另外导出Excel的代码是放在窗体按钮控件下快呢,还是放在module里面调用块呢?
    能否举个打印的例子呢(直接连接打印机打印)?
    谢谢
      

  6.   

    手工建立好格式,保存为模板 .xlt。
    改成用模板新建工作簿
    Set xlBook = xlApp.Workbooks.Add("C:\a.xlt")一样快xlSheet.PrintOut