设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1099|回复: 1
打印 上一主题 下一主题

[与其它组件] 用VBA代码导出excel后备注字段无法导出

[复制链接]
跳转到指定楼层
1#
发表于 2007-7-18 05:13:00 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
<>用VBA编写如下代码后发现导出excel时如果备注字段“NOTE”内容太多,导致导出的备注字段为空,如果内容不多就正常,是否是格式问题,代码如下,请高手指教!</P>
<>====================================</P>
<>===============================<BR>Private Sub 导出到Excel_Click() </P>
<p>
<P>On Error GoTo Err_OutputToExcel<BR>Dim xlApp As New Excel.Application<BR>Dim xlBook As Excel.Workbook<BR>Dim xlsheet As New Excel.Worksheet<BR>Dim Conn As New ADODB.Connection<BR>Dim Rec As New ADODB.Recordset<BR>Dim strSQL As String<BR>Dim i As Integer, j As Integer, m As Integer, n As Integer<BR>    <BR>Set xlApp = CreateObject("Excel.Application")<BR>Set xlBook = xlApp.Workbooks.add<BR>Set xlsheet = xlBook.Worksheets(1)<BR>Set Conn = CurrentProject.Connection </P>
<p>
<P><FONT color=#000000>strSQL = "SELECT * FROM QUOTE_MAIN " <BR>strSQL = strSQL &amp; "Where QUOTE_NO_TIMES =" &amp; Me.QUOTE_NO_TIMES &amp; ";"</FONT> </P>
<p>
<P>Rec.Open strSQL, Conn, adOpenStatic, adLockOptimistic </P>
<p>
<P>i = 1: j = 9<BR>   <BR>xlsheet.Name = Me.QUOTE_NO<BR>xlApp.Visible = True        '显示 </P>
<p>
<P>    With xlsheet<BR>    .Columns("a:j").Font.Size = 10<BR>    .Columns("a:j").VerticalAlignment = xlVAlignCenter  '垂直居中<BR>    .Columns("A:J").HorizontalAlignment = xlHAlignLeft '1列水平居中对齐<BR>    End With </P>
<p>
<P>    With xlsheet<BR>            '设置列宽<BR>           .Cells(1, 1).ColumnWidth = 13<BR>           .Cells(1, 2).ColumnWidth = 20<BR>           .Cells(1, 3).ColumnWidth = 6<BR>           .Cells(1, 4).ColumnWidth = 7.5<BR>           .Cells(1, 5).ColumnWidth = 15<BR>           .Cells(1, 6).ColumnWidth = 10<BR>           .Cells(1, 7).ColumnWidth = 6<BR>           .Cells(1, 8).ColumnWidth = 15<BR>           .Cells(1, 9).ColumnWidth = 9<BR>           .Cells(1, 10).ColumnWidth = 15<BR>           <BR>    End With<BR>    <BR>      '设置表头<BR>    xlApp.Range("A1:" &amp; Chr(64 + Rec.Fields.Count) &amp; 1).Select<BR>    With xlApp.Selection<BR>        .HorizontalAlignment = xlCenter<BR>        .VerticalAlignment = xlCenter<BR>        .WrapText = False<BR>        .Orientation = 0<BR>        .AddIndent = False<BR>        .IndentLevel = 0<BR>        .ShrinkToFit = False<BR>        .ReadingOrder = xlContext<BR>        .MergeCells = False<BR>    End With<BR>    xlApp.Selection.Merge<BR>      <BR>    xlApp.Range("A1:" &amp; Chr(64 + Rec.Fields.Count) &amp; 1).Select<BR>    With xlApp.Selection<BR>        .HorizontalAlignment = xlCenter<BR>        .VerticalAlignment = xlCenter<BR>        .WrapText = False<BR>        .Orientation = 0<BR>        .AddIndent = False<BR>        .IndentLevel = 0<BR>        .ShrinkToFit = False<BR>        .ReadingOrder = xlContext<BR>        .MergeCells = False<BR>    End With<BR>    xlApp.Selection.Merge<BR>   <BR>     xlApp.Range("A1").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = "QUOTE SHEET"<BR>        With xlApp.Selection.Font<BR>        .Name = "Arial Black"<BR>        .Size = 16<BR>        .Strikethrough = False<BR>        .Superscript = False<BR>        .Subscript = False<BR>        .OutlineFont = False<BR>        .Shadow = False<BR>        .Underline = xlUnderlineStyleNone<BR>        .ColorIndex = xlAutomatic<BR>    End With </P>
<p>
<P>    xlApp.Range("A3").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = "PRICE NO."<BR>    xlApp.Range("B3").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = QUOTE_NO<BR>          <BR>    xlApp.Range("A4").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = "PRICE TIMES"<BR>    xlApp.Range("B4").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = QUOTE_TIMES<BR>    <BR>    xlApp.Range("A5").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = "FOLLOW NO."<BR>    xlApp.Range("B5").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = SALPME_FOLLOW_NO<BR>    <BR>    xlApp.Range("A6").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = "FACTORY"<BR>    xlApp.Range("B6").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = FACTORY<BR>    <BR>    xlApp.Range("A7").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = "CUSTOMER"<BR>    xlApp.Range("B7").Select<BR>    xlApp.ActiveCell.FormulaR1C1 = CUSTOM
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
发表于 2007-7-18 19:32:00 | 只看该作者
EXCEL单元格最多容255个字符
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-5-16 11:19 , Processed in 0.097166 second(s), 25 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表