想把一些信息输出到word中
那位高手能指点一下思路,最好能给我一段源代码:),非常感谢!
从来没做过,感觉没有头绪!

解决方案 »

  1.   


    http://www.google.com/search?q=%E4%BF%A1%E6%81%AF%E8%BE%93%E5%87%BA%E5%88%B0word&ie=UTF-8&hl=zh-CN&btnG=Google%E6%90%9C%E7%B4%A2&lr=
    所有网站  约有 22,300 项符合信息输出到word的查询结果,以下是第 1 - 10 项。 (搜索用时 0.24 秒) 
    怎么将datawindow(grid形式)的数据输出到word文档?
    ... Q : 怎么将datawindow(grid形式)的数据输出到word文档?. 主要解答者:
    balloonman2002, 提交人: sengg. 感谢: balloonman2002. 审核者: wu_07, 社区对
    应贴子: 查看. A : ---- 
    通过 ... 
    community.csdn.net/Expert/FAQ/FAQ_Index.asp?id=97301 - 20k - 网页快照 - 类似网页
      

  2.   

    具体你要看一下你想怎么输出。
    你可以到搜索栏里面搜索一下VB版以前的关于Word、Excel操作的回答和Faq。
      

  3.   

    就是从数据库里面读出来的数据
    以报表的形式输出到word上面,然后发给别人:)
    谢谢啊
      

  4.   

    Private Sub cmdSwatch_Click()
    Dim xls As excel.Application
    Dim xlbook As excel.Workbook
    'On Error GoTo exlError
    Dim i As Integer
        If Dir(Text1.Text) <> "" Then '此目录下如有同名文件给出提示,并作相应处理
            If MsgBox("文件已存在,是否覆盖!", vbYesNo + vbQuestion, "另存为工程造价文件") = vbNo Then
                Exit Sub
            Else
                Kill (Text1.Text) '删除文件
            End If
        End If    '************打开工作表***************
        Set xls = New excel.Application
        xls.Visible = True
        Set xlbook = xls.Workbooks.Add
        '*********************************
        For i = 0 To 14
            If Check2(i).Value = vbChecked Then
                Select Case i
                    Case 8
                        ToExcelJDanJiaSum.ToExcelJDanJiaSum xlbook, xls
                    Case 9
                        ToExcelADanJiaSum.ToExcelADanJiaSum xlbook, xls
                    Case 10
                        ToExcelCailiao.ToExcelCailiao xlbook, xls
                    Case 11
                        ToExcelTsf.ToExcelTsf xlbook, xls
                    Case 12
                        ToExcelZgcl.ToExcelZgcl xlbook, xls
                End Select
            End If
        Next
        For i = 0 To 6
            If Check3(i).Value = vbChecked Then
                Select Case i
                    Case 0
                        ToExcelMan.ToExcelMan xlbook, xls
                    Case 1
                        ToExcelFSD_CL.ToExcelFSD_CL xlbook, xls
                    Case 2
                        ToExcelHNT.ToExcelHNT xlbook, xls
                    Case 3
                        ToExcelZsf.ToExcelZsf xlbook, xls
                    Case 4
                        ToExcelJingChang.ToExcelJingChang xlbook, xls
                    Case 5
                        ToExcelJDanJia.ToExcelJDanJia xlbook, xls
                    Case 6
                        ToExcelADanJia.ToExcelADanJia xlbook, xls
                End Select
            End If
        Next
        
        xlbook.SaveAs Text1.Text '保存EXCEL文件
        '***************************关闭EXCEL对象*******************
        If Check1.Value = vbChecked Then
            xlbook.Close
            xls.Quit
        End If
        Set xlbook = Nothing
        Set xls = Nothing
        Exit Sub
    'exlError:
       ' MsgBox Err.Description, vbOKOnly + vbCritical, "警告"
    End Sub
      

  5.   

    Option Explicit
    Public Sub ToExcelZgcl(ByRef xlbook, ByRef xls) '输出总工程量
        Dim con As New ADODB.Connection
        Dim rst_gcl As New ADODB.Recordset
        Dim rst_qm As New ADODB.Recordset
        '**************************连接数据库****************************************
        con.CursorLocation = adUseClient
        con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"
        con.Open
        rst_gcl.Open "zonggcl", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开工程量汇总表
        If Not (rst_gcl.BOF And rst_gcl.EOF) Then
            rst_gcl.MoveFirst
        End If
        rst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTable '打开签名表
        rst_qm.MoveFirst
        '****************************工作表初使化***********************************
        Dim xlsheet As excel.Worksheet
        Set xlsheet = xlbook.Sheets.Add '添加一张工作表
        xlsheet.Name = "工程量汇总"
        xls.ActiveSheet.PageSetup.Orientation = xlLandscape '纸张设置为横向
        xlsheet.Columns("a:j").Font.Size = 10
        xlsheet.Columns("a:j").VerticalAlignment = xlVAlignCenter  '垂直居中
        xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐
        xlsheet.Columns(1).ColumnWidth = 8
        xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeft
        xlsheet.Columns(2).ColumnWidth = 26
        xlsheet.Columns("c:j").HorizontalAlignment = xlHAlignRight
        xlsheet.Columns("c:j").ColumnWidth = 10
        xlsheet.Columns("c:j").NumberFormatLocal = "0.00_ " '3到10列保留两位小数
        '***************************写入标头*************************************
        xlsheet.Rows(1).RowHeight = 40
        xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 10)).MergeCells = True
        xlsheet.Cells(1, 1).Value = "工程量汇总"
        xlsheet.Cells(1, 1).Font.Size = 14
        xlsheet.Cells(1, 1).Font.Bold = True
        
        xlsheet.Rows(2).RowHeight = 18
        xlsheet.Rows(2).HorizontalAlignment = xlHAlignCenter
        xlsheet.Cells(2, 1).Value = "序号"
        xlsheet.Cells(2, 2).Value = "工程项目及名称"
        xlsheet.Cells(2, 3).Value = "土方开挖(m3)"
        xlsheet.Cells(2, 4).Value = "石方开挖(m3)"
        xlsheet.Cells(2, 5).Value = "土方回填(m3)"
        xlsheet.Cells(2, 6).Value = "洞挖石方(m3)"
        xlsheet.Cells(2, 7).Value = "砼浇筑(m3)"
        xlsheet.Cells(2, 8).Value = "钢筋制安(t)"
        xlsheet.Cells(2, 9).Value = "砌石工程(m3)"
        xlsheet.Cells(2, 10).Value = "灌浆工程(m)"
        
        xls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$2" '固定表头
        '***************************写入内容*************************
        Dim i As Integer
        i = 3 'i控制行
        Dim j As Integer 'j控制列
        Dim countpage As Integer
        countpage = 0 '控制页
        Do While Not rst_gcl.EOF
            xlsheet.Rows(i).RowHeight = 18 '控制行高
            For j = 1 To 10
                xlsheet.Cells(i, j) = rst_gcl.Fields(j) '将工程理库中的一条记录的第一个字段写入工作表中
            Next
            '每18行为一页,如果数据超出一页时进行特殊处理
            If i > 18 Then
                xls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行
            End If
            If i Mod 18 = 0 Then
                If countpage = 0 Then
                    xlsheet.Range(xlsheet.Cells(2, 1), xlsheet.Cells(i, 10)).Borders.LineStyle = xlContinuous '首页加边框
                Else
                    xlsheet.Range(xlsheet.Cells(23 + (countpage - 1) * 18, 1), xlsheet.Cells(i, 10)).Borders.LineStyle = xlContinuous '中间页加边框
                End If
                i = i + 2 '加一条空行
            
                '******************************在非尾页写入签名**************************************
                xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = True
                xlsheet.Cells(i, 1).Value = Space(64) & rst_qm.Fields(0)
                xlsheet.Rows(i).RowHeight = 30
                i = i + 1 '换行
                xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = True
                xlsheet.Cells(i, 1).Value = Space(50) & rst_qm.Fields(1)
                xlsheet.Rows(i).RowHeight = 15
                i = i + 1
                xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = True
                xlsheet.Cells(i, 1).Value = Space(55) & rst_qm.Fields(2)
                xlsheet.Rows(i).RowHeight = 30
                '****************************************************************************
                
                xlsheet.HPageBreaks.Add (xlsheet.Rows(i + 1)) '添加分页符
                countpage = countpage + 1 '换页
            End If
            i = i + 1
            rst_gcl.MoveNext
        Loop
            xlsheet.Range(xlsheet.Cells(23 + (countpage - 1) * 18, 1), xlsheet.Cells(i - 1, 10)).Borders.LineStyle = xlContinuous '尾页加边框
            i = i + 1 '加入一空行
            '*********************************在尾页加签名***************************************
            xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = True
            xlsheet.Cells(i, 1).Value = Space(64) & rst_qm.Fields(0)
            xlsheet.Rows(i).RowHeight = 30
            i = i + 1 '换行
            xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = True
            xlsheet.Cells(i, 1).Value = Space(50) & rst_qm.Fields(1)
            xlsheet.Rows(i).RowHeight = 15
            i = i + 1
            xlsheet.Range(xlsheet.Cells(i, 1), xlsheet.Cells(i, 10)).MergeCells = True
            xlsheet.Cells(i, 1).Value = Space(55) & rst_qm.Fields(2)
            xlsheet.Rows(i).RowHeight = 30
            '***********************************************************************************
            xls.ActiveWindow.View = xlPageBreakPreview '分页预览
            xls.ActiveWindow.Zoom = 100
        
        If con.State = adStateOpen Then
            rst_gcl.Close
            rst_qm.Close
            Set rst_gcl = Nothing
            Set rst_qm = Nothing
            con.Close
            Set con = Nothing
        End If
        Set xlsheet = Nothing
    End Sub
     
      

  6.   

    Option ExplicitPublic Sub ToExcelTsf(ByRef xlbook, ByRef xls)
        Dim con As New ADODB.Connection
        Dim rst_tsf As New ADODB.Recordset
        Dim rst_qm As New ADODB.Recordset
        '**********************************连接数据库************************
        con.CursorLocation = adUseClient
        con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strConnection & ";Persist Security Info=False"
        con.Open
        rst_tsf.Open "tdefeiyong", con, adOpenKeyset, adLockOptimistic, adCmdTable
        If Not (rst_tsf.BOF And rst_tsf.EOF) Then
            rst_tsf.MoveFirst
        End If
        rst_qm.Open "qianming", con, adOpenKeyset, adLockOptimistic, adCmdTable
        rst_qm.MoveFirst
        '*********************************工作表初使化**********************************
        Dim xlsheet As excel.Worksheet
        Set xlsheet = xlbook.Sheets.Add
        xlsheet.Name = "机械台时、组时费汇总表"
        xlsheet.Columns(1).ColumnWidth = 5
        xlsheet.Columns(2).ColumnWidth = 20
        xlsheet.Columns(3).ColumnWidth = 7
        xlsheet.Columns(4).ColumnWidth = 7
        xlsheet.Columns(5).ColumnWidth = 7
        xlsheet.Columns(6).ColumnWidth = 7
        xlsheet.Columns(7).ColumnWidth = 7
        xlsheet.Columns(8).ColumnWidth = 7
        xlsheet.Columns(9).ColumnWidth = 7
        xlsheet.Columns("A:I").Font.Size = 9
        xlsheet.Columns("A:I").VerticalAlignment = xlVAlignCenter  '垂直居中
        xlsheet.Columns(1).HorizontalAlignment = xlHAlignCenter '1列水平居中对齐
        xlsheet.Columns(2).HorizontalAlignment = xlHAlignLeft '2列水平左对齐
        '******************************写入标头************************************
        xlsheet.Rows(1).RowHeight = 35
        xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 9)).MergeCells = True
        xlsheet.Cells(1, 1).Font.Size = 14
        xlsheet.Cells(1, 1).Font.Bold = True
        xlsheet.Cells(1, 1).Value = "机械台时、组时费汇总表"
        
        xlsheet.Cells(2, 9).Value = "单位:元"
        xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(5, 1)).MergeCells = True
        xlsheet.Cells(3, 1).Value = "编号"
        xlsheet.Range(xlsheet.Cells(3, 2), xlsheet.Cells(5, 2)).MergeCells = True
        xlsheet.Cells(3, 2).Value = "机械名称"
        xlsheet.Range(xlsheet.Cells(3, 3), xlsheet.Cells(5, 3)).MergeCells = True
        xlsheet.Cells(3, 3).Value = "台时费"
        xlsheet.Range(xlsheet.Cells(3, 4), xlsheet.Cells(3, 9)).MergeCells = True
        xlsheet.Cells(3, 4).Value = "其      中"
        xlsheet.Range(xlsheet.Cells(3, 3), xlsheet.Cells(5, 3)).MergeCells = True
        xlsheet.Cells(3, 3).Value = "台时费"
        xlsheet.Range(xlsheet.Cells(4, 4), xlsheet.Cells(5, 4)).MergeCells = True
        xlsheet.Cells(4, 4).Value = "折旧费"
        xlsheet.Range(xlsheet.Cells(4, 5), xlsheet.Cells(5, 5)).MergeCells = True
        xlsheet.Cells(4, 5).Value = "修理替换费"
        xlsheet.Range(xlsheet.Cells(4, 6), xlsheet.Cells(5, 6)).MergeCells = True
        xlsheet.Cells(4, 6).Value = "安拆费"
        xlsheet.Range(xlsheet.Cells(4, 7), xlsheet.Cells(5, 7)).MergeCells = True
        xlsheet.Cells(4, 7).Value = "人工费"
        xlsheet.Range(xlsheet.Cells(4, 8), xlsheet.Cells(5, 8)).MergeCells = True
        xlsheet.Cells(4, 8).Value = "燃料费"
        xlsheet.Range(xlsheet.Cells(4, 9), xlsheet.Cells(5, 9)).MergeCells = True
        xlsheet.Cells(4, 9).Value = "其他费"
        
        xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(5, 9)).HorizontalAlignment = xlHAlignCenter
        xls.ActiveSheet.PageSetup.PrintTitleRows = "$1:$5" '固定表头
        '****************************************写入内容*************************************
        Dim i As Integer
            i = 6
        Do While Not rst_tsf.EOF
            xlsheet.Cells(i, 1).Value = rst_tsf.Fields("nn")
            xlsheet.Cells(i, 2).Value = rst_tsf.Fields("name")
            xlsheet.Cells(i, 3).Value = rst_tsf.Fields("price")
            xlsheet.Cells(i, 4).Value = rst_tsf.Fields("zhejiu")
            xlsheet.Cells(i, 5).Value = rst_tsf.Fields("xiuli")
            xlsheet.Cells(i, 6).Value = rst_tsf.Fields("anchai")
            xlsheet.Cells(i, 7).Value = rst_tsf.Fields("rengong")
            xlsheet.Cells(i, 8).Value = rst_tsf.Fields("dongli")
            xlsheet.Cells(i, 9).Value = rst_tsf.Fields("qita")
            If i > 22 Then
                xls.ActiveWindow.SmallScroll Down:=1 '活动窗口内容向下滚动1行
            End If
            i = i + 1
            rst_tsf.MoveNext
        Loop
        xlsheet.Range(xlsheet.Cells(6, 3), xlsheet.Cells(i - 1, 9)).NumberFormatLocal = "0.00_ " '保留两位小数
        
        '*********************************添加边框**********************************
            xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(i - 1, 9)).Borders.LineStyle = xlContinuous
        '******************************************************************************
        xls.ActiveSheet.PageSetup.BottomMargin = Application.InchesToPoints(2.2) '设置下侧面边距
        xls.ActiveSheet.PageSetup.FooterMargin = Application.InchesToPoints(1) '设置页脚高
        xls.ActiveSheet.PageSetup.CenterFooter = "&10" & rst_qm.Fields(0) & Chr(10) & Chr(10) & rst_qm.Fields(1) & Chr(10) & Chr(10) & rst_qm.Fields(2) '加页脚
        xls.ActiveWindow.View = xlPageBreakPreview '分页预览
        xls.ActiveWindow.Zoom = 100
        '***************************关闭记录集*******************
        If con.State = adStateOpen Then
            rst_tsf.Close
            rst_qm.Close
            Set rst_tsf = Nothing
            Set rst_qm = Nothing
            con.Close
            Set con = Nothing
        End If
        Set xlsheet = Nothing
    End Sub
    精彩的后续