用VBA编写如下代码后发现导出excel时如果备注字段“NOTE”内容太多，导致导出的备注字段为空，如果内容不多就正常，是否是格式问题，代码如下，请高手指教！
====================================
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Private Sub 导出到Excel_Click()
On Error GoTo Err_OutputToExcel
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlsheet As New Excel.Worksheet
Dim Conn As New ADODB.Connection
Dim Rec As New ADODB.Recordset
Dim strSQL As String
Dim i As Integer, j As Integer, m As Integer, n As Integer
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.add
Set xlsheet = xlBook.Worksheets(1)
Set Conn = CurrentProject.Connection
strSQL = "SELECT * FROM QUOTE_MAIN "
strSQL = strSQL & "Where QUOTE_NO_TIMES =" & Me.QUOTE_NO_TIMES & ";"
Rec.Open strSQL, Conn, adOpenStatic, adLockOptimistic
i = 1: j = 9
xlsheet.Name = Me.QUOTE_NO
xlApp.Visible = True '显示
With xlsheet
.Columns("a:j").Font.Size = 10
.Columns("a:j").VerticalAlignment = xlVAlignCenter '垂直居中
.Columns("A:J").HorizontalAlignment = xlHAlignLeft '1列水平居中对齐
End With
With xlsheet
'设置列宽
.Cells(1, 1).ColumnWidth = 13
.Cells(1, 2).ColumnWidth = 20
.Cells(1, 3).ColumnWidth = 6
.Cells(1, 4).ColumnWidth = 7.5
.Cells(1, 5).ColumnWidth = 15
.Cells(1, 6).ColumnWidth = 10
.Cells(1, 7).ColumnWidth = 6
.Cells(1, 8).ColumnWidth = 15
.Cells(1, 9).ColumnWidth = 9
.Cells(1, 10).ColumnWidth = 15
End With
'设置表头
xlApp.Range("A1:" & Chr(64 + Rec.Fields.Count) & 1).Select
With xlApp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlApp.Selection.Merge
xlApp.Range("A1:" & Chr(64 + Rec.Fields.Count) & 1).Select
With xlApp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
xlApp.Selection.Merge
xlApp.Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = "QUOTE SHEET"
With xlApp.Selection.Font
.Name = "Arial Black"
.Size = 16
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
xlApp.Range("A3").Select
xlApp.ActiveCell.FormulaR1C1 = "PRICE NO."
xlApp.Range("B3").Select
xlApp.ActiveCell.FormulaR1C1 = QUOTE_NO
xlApp.Range("A4").Select
xlApp.ActiveCell.FormulaR1C1 = "PRICE TIMES"
xlApp.Range("B4").Select
xlApp.ActiveCell.FormulaR1C1 = QUOTE_TIMES
xlApp.Range("A5").Select
xlApp.ActiveCell.FormulaR1C1 = "FOLLOW NO."
xlApp.Range("B5").Select
xlApp.ActiveCell.FormulaR1C1 = SALPME_FOLLOW_NO
xlApp.Range("A6").Select
xlApp.ActiveCell.FormulaR1C1 = "FACTORY"
xlApp.Range("B6").Select
xlApp.ActiveCell.FormulaR1C1 = FACTORY
xlApp.Range("A7").Select
xlApp.ActiveCell.FormulaR1C1 = "CUSTOMER"
xlApp.Range("B7").Select
xlApp.ActiveCell.FormulaR1C1 = CUSTOMER
xlApp.Range("H3").Select
xlApp.ActiveCell.FormulaR1C1 = "ISSUE ORDER"
xlApp.Range("I3").Select
xlApp.ActiveCell.FormulaR1C1 = ISSUE_ORDER
xlApp.Range("H4").Select
xlApp.ActiveCell.FormulaR1C1 = "DATE"
xlApp.Range("I4").Select
xlApp.ActiveCell.FormulaR1C1 = Format(DATE, "YYYY-MM-DD")
With xlsheet
.Range("A3:I7").Font.Bold = True
'标题字体加粗
End With
xlApp.Rows("3:7").Select
With xlApp.Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'设置边框
xlApp.Range("A" & j & ":" & Chr(64 + Rec.Fields.Count) & Rec.RecordCount + j).Select
xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With xlApp.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlApp.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlApp.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlApp.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlApp.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'自动换行
With xlApp.Selection
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
'设置字体
With xlApp.Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With xlsheet
'设置列标题
For m = 0 To Rec.Fields.Count - 1
.Cells(j, m + 1) = Rec.Fields(m).Name
Next
'设置表主体内容
Do While Not Rec.EOF
For n = 0 To Rec.Fields.Count - 1
.Cells(i + j, n + 1) = Rec.Fields(n)
Next
i = i + 1
Rec.MoveNext
Loop
End With
xlApp.Range(("A" & Rec.RecordCount + j + 2), ("J" & Rec.RecordCount + j + 2)).Select
xlApp.ActiveCell.FormulaR1C1 = "NOTE："
xlApp.Selection.Merge
'设置字体
With xlApp.Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
xlApp.Range(("A" & Rec.RecordCount + j + 3), ("J" & Rec.RecordCount + j + 3)).Select
xlApp.ActiveCell.FormulaR1C1 = NOTE
xlApp.Selection.Merge
'设置字体
With xlApp.Selection.Font
.Name = "Arial"
.Size = 9
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Rec.close
Set Rec = Nothing
Set Conn = Nothing
Set xlApp = Nothing
Set xlsheet = Nothing
Exit_OutputToExcel:
Exit Sub
Err_OutputToExcel:
Set Rec = Nothing
Set Conn = Nothing
Set xlApp = Nothing
Set xlsheet = Nothing
MsgBox Err.description
Resume Exit_OutputToExcel
End Sub
