为何第一次执行可以，第二次执行不可以？

[cnming]

代码大概如下：

包含两个Sub，其中SetAllFrame是VBA中把Excel网格线变黑的功能，FillExcel是往Excel中填写数据的功能
为何第一次可以完好之行，如果程序没有退出，则第二次无法执行SetAllFrame，也就是无法把网格线变黑？



Private Sub FillExcel(blnPrintPreview As Boolean)
Dim xlApp As Excel.Application
Dim xlBook As Workbook, xlSheet As workSheet
Dim rsOut As ADODB.Recordset
Dim strSource As String, strDestination As String
Dim lngRow As Long
Dim dblContainerSum As Double
Dim dblLeadSum As Double
Dim dblAllSum As Double

On Error Resume Next

Set rsOut = New ADODB.Recordset

Call BuildSQL

Set rsOut = conn.Execute(strSQL)

If Err Then
Err.Clear
Exit Sub
End If

If rsOut.EOF Or rsOut.BOF Then
Exit Sub
End If

strSource = App.Path & "\ReportFeeInstance.xls"
strDestination = App.Path & "\ReportFeeInstanceTemp.xls"

FileCopy strSource, strDestination

Set xlApp = CreateObject("Excel.Application")
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(strDestination)
Set xlSheet = xlBook.Worksheets(1)

If Err Then
xlBook.Save
xlBook.Close
xlApp.Quit
Err.Clear
Exit Sub
End If

rsOut.MoveFirst
lngRow = 4

While Not (rsOut.EOF Or rsOut.BOF)
lngRow = lngRow + 1

xlSheet.Cells(lngRow, 2) = rsOut.Fields("aaa").Value
xlSheet.Cells(lngRow, 3) = rsOut.Fields("bbb").Value
xlSheet.Cells(lngRow, 4) = rsOut.Fields("ccc").Value
xlSheet.Cells(lngRow, 5) = rsOut.Fields("ddd").Value
xlSheet.Cells(lngRow, 6) = rsOut.Fields("eee").Value
xlSheet.Cells(lngRow, 7) = rsOut.Fields("fff").Value
xlSheet.Cells(lngRow, 8) = rsOut.Fields("ggg").Value
xlSheet.Cells(lngRow, 9) = rsOut.Fields("hhh").Value
xlSheet.Cells(lngRow, 10) = rsOut.Fields("iii").Value
xlSheet.Cells(lngRow, 11) = rsOut.Fields("jjj").Value

rsOut.MoveNext
Wend

rsOut.Close

If Err Then
Err.Clear
End If

'********************************这里调用了那个画表格线的VBA
SetAllFrame 4, 2, lngRow, 11
xlBook.Save

If blnPrintPreview = True Then
xlSheet.PrintPreview
CloseApplication "Excel"
Else
xlSheet.PrintOut
CloseApplication "Excel"
End If
xlBook.Close
xlApp.Quit

If Err Then
Err.Clear
End If

If Err Then
Err.Clear
Exit Sub
End If
End Sub

Private Sub SetAllFrame(lngRowStart As Long, lngColumnStart As Long, lngRowEnd As Long, lngColumnEnd As Long)
On Error Resume Next

Range(Cells(lngRowStart, lngColumnStart), Cells(lngRowEnd, lngColumnEnd)).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

If Err Then
Err.Clear
End If
End Sub

[cnming]

看来大家都休息去了

[Vii]

gz

[hhjjhjhj]

Private Sub SetAllFrame(lngRowStart As Long, lngColumnStart As Long, lngRowEnd As Long, lngColumnEnd As Long,xlst as Worksheet)'加SHEET变量
With xlst
.Range..........'range前加“。”Cell前也加“。”
.Selection..........'加“。”
。。。。。。。
。。。。。。。。。
End with
end sub
一句话------对象丢失了父亲了！

[cnming]

xlst.Selection 不对，xlst没有这个

xlst.Range没错了，运行的时候也不会出错了，但是第一次有画网格线，第二次只有执行了选中但是没有画网格线

请多帮忙，谢谢。


还有，我如何才能完完全全关闭Excel，因为我每当执行一次Private Sub FillExcel(blnPrintPreview As Boolean)
之后，如果不退出这个进程，就无法运行Excel，但是使用Private Sub FillExcel(blnPrintPreview As Boolean)
还是正常可以打开Excel

[hhjjhjhj]

呵，对了，应该如下。这些处理好了，EXCEL就可顺利关闭。
xlst.Application.Selection

[cnming]

谢谢，成功了，我很菜的，只敢找些VBA的来做，不会自己写

[cnming]

请问为何第一次可以运行？而第二次不可以运行？