我試著給妳改了壹下，妳看是不是這樣。
Private Sub Image6_Click() '調出excel，以便打印
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
'********************追加代碼開始*********************
On Error GoTo Image6_Click_Err
'********************追加代碼結束*********************
Set xlapp = CreateObject("excel.application")
Set xlbook = Excel.Workbooks.Open(App.path & "\data\base.xls")
Set xlsheet = Excel.Worksheets(1)
xlapp.Visible = True
With xlsheet
.Cells(5, 3) = textname.Text '姓名
.Cells(5, 5) = "" '主險
.Cells(5, 7) = "" '附加險
Dim excel_i
For excel_i = 0 To 7
.Cells(excel_i + 7, 3) = Textresult1(excel_i) & " 元" '醫療費
.Cells(excel_i + 7, 4) = Textresult2(excel_i) & " 元" '扣除費
Next excel_i
.Cells(14, 5) = Textresult3(7) & " 元" '理算費
.Cells(15, 2) = Labelresult.Caption '理算公式
End With
xlbook.SaveAs "d:\計算表-" & textname.Text & ".xls"
'********************追加代碼開始*********************
Exit Sub
Image6_Click_Err:
If Not xlbook Is Nothing Then
xlbook.Close
Set xlbook = Nothing
End If
If Not xlapp Is Nothing Then
xlapp.Quit
Set xlapp = Nothing
End If
'********************追加代碼結束*********************
End Sub