用Excel做报表打印的问题

[dlmhtao]

用Excel做报表，提前做好一个模版，将数据保存在另一个Excel文件中，不知道怎么实现好。

[edreamy]

找了半天只找到我用VB6写的，也给你看看吧。
Dim strPath As String
Dim strName As String
Dim objXlApp As Object
Dim num1 As Integer
Dim bPos As Long
Dim I As Integer
Dim strPos As String

On Error GoTo err_label
Auto_open = 0

' Macro1 Macro
strPath = Left(WK_INPUT, InStrRev(WK_INPUT, "\"))
strName = Left(Right(WK_INPUT, InStrRev(WK_INPUT, "\") - 3), InStr(Right(WK_INPUT, InStrRev(WK_INPUT, "\") - 3), ".")) & "xls"

Set objXlApp = CreateObject("excel.application")

objXlApp.Workbooks.Add Template:=strPath & strName
objXlApp.ActiveWindow.LargeScroll ToRight:=-1
'csv拞偺峴悢
If input_Count(WK_INPUT) = 0 Then
objXlApp.quit
Call MsgInfoX("000005", "")
Auto_open = -1
Exit Function
End If
'暸悢
'2002/10/22 棲垽壺
'num1 = input_Count(WK_INPUT) / lngMaxrow
num1 = RoundA(input_Count(WK_INPUT) / lngMaxrow, 0, 3)
'END
With objXlApp.ActiveWorkbook.ActiveSheet
If num1 > 1 Then
.Range("1:" & lngMaxrow).Select
.application.CutCopyMode = False
objXlApp.Selection.Copy
' .Copy
' ActiveWindow.LargeScroll ToRight:=-1
bPos = lngMaxrow + 1
For I = 1 To num1 - 1
strPos = bPos
strPos = "A" & strPos
.Range(strPos).Select
.Paste
bPos = bPos + lngMaxrow
Next
End If

objXlApp.ActiveWindow.LargeScroll ToRight:=-1
.Range("A1").Select
With .QueryTables.Add(Connection:= _
"TEXT;" & WK_INPUT, Destination:=.Range("A1"))
.Name = strName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh 'BackgroundQuery:=False
End With
End With
objXlApp.ActiveWorkbook.ActiveSheet.application.Visible = True
objXlApp.ActiveWorkbook.ActiveSheet.PrintPreview
objXlApp.quit

Exit Function
err_label:
Call ErrSyori("MdlJigyo", "Auto_open")
objXlApp.quit
Call MsgInfoX("000009", "")
Auto_open = -1

[edreamy]

注释是日文的，不好意思我也懒得改，将就着看吧。