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,
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,
要不就不合并,导出excel之后手工合并.
最大的耗时并不总是在填充数据的时候。
2、楼主在导出过程中又设置格式,可以先做一个设置好格式的空文件,
以后每次导出时都使用这个模板,就不需要再设置格式什么的了
只需要填写数据
3、你下面循环中,填写一行的时候,试着这样进行
将这一行每个单元格的数据用vbTab分隔放到粘贴板中,然后到EXCEL中进行粘贴
多行的话,每行用vbnewline分隔
这样比你一个单元格一个单元格地操作要快很多
sdfkfkd:
先做好一个空文件,再导入数据?这个如何做呢另外导出Excel的代码是放在窗体按钮控件下快呢,还是放在module里面调用块呢?
能否举个打印的例子呢(直接连接打印机打印)?
谢谢
改成用模板新建工作簿
Set xlBook = xlApp.Workbooks.Add("C:\a.xlt")一样快xlSheet.PrintOut