读书人

高分求!能用程序创建WORD表格并写入数

发布时间: 2012-01-15 22:57:49 作者: rapoo

高分求!!!!!!!!能用程序创建WORD表格并写入数据的方法
要把数据写入一个WORD表格.但表格并不规则.如何能创建表格并确定位置写入数据呢??表格样式如下:
A B C D
┌──┬──────┬──────┬───┐
├──┴──────┴──────┴───┤
├──┬──────┬──────┬───┤
│  ├──────┴──────┴───┤
└──┴─────────────────┘
希望能顺便告知控制页眉页脚的方法.谢谢!编写环境VB2005+OFFICE2000


[解决办法]
'插入表格
Public Sub InsertTable(ByRef table As DataTable)
Dim oTable As Word.Table
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
rowIndex = 1
colIndex = 0
If (table.Rows.Count = 0) Then
Exit Sub
End If

NumRows = table.Rows.Count + 1
NumColumns = table.Columns.Count
oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)


'初始化列
Dim Row As DataRow
Dim Col As DataColumn
'For Each Col In table.Columns
' colIndex = colIndex + 1
' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
'Next

'将行添入表格
For Each Row In table.Rows
rowIndex = rowIndex + 1
colIndex = 0
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
Next
oTable.Rows(1).Delete()
oTable.AllowAutoFit = True
oTable.ApplyStyleFirstColumn = True
oTable.ApplyStyleHeadingRows = True

End Sub
'插入表格(修改为在原有表格的基础上添加数据)
Public Sub InsertTable2(ByRef table As DataTable, ByVal strbmerge As String, ByVal totalrow As Integer)
Dim oTable As Word.Table
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
Dim strm() As String
Dim i As Integer
rowIndex = 1
colIndex = 0

If (table.Rows.Count = 0) Then
Exit Sub
End If

NumRows = table.Rows.Count + 1
NumColumns = table.Columns.Count
'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)


'初始化列
Dim Row As DataRow
Dim Col As DataColumn
'For Each Col In table.Columns
' colIndex = colIndex + 1
' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
'Next

'将行添入表格
For Each Row In table.Rows
colIndex = 0
GotoRightCell()
oWordApplic.Selection.InsertRows(1)
For Each Col In table.Columns
GotoRightCell()
colIndex = colIndex + 1
Try
oWordApplic.Selection.TypeText(Row(Col.ColumnName))
Catch ex As Exception
oWordApplic.Selection.TypeText( " ")
End Try
'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
Next
'如果strbmerge不为空.则要合并相应的行和列
If strbmerge.Trim().Length <> 0 Then
strm = strbmerge.Split( "; ")
For i = 1 To strm.Length - 1
If strm(i).Split( ", ").Length = 2 Then
MergeDouble(totalrow, strm(0), strm(i).Split( ", ")(1), strm(i).Split( ", ")(0))
End If
MergeSingle(totalrow, strm(0), strm(i))


Next
End If
'删除可能多余的一行
'GotoRightCell()
'GotoDownCell()
'oWordApplic.Selection.Rows.Delete()
'oTable.AllowAutoFit = True
'oTable.ApplyStyleFirstColumn = True
'oTable.ApplyStyleHeadingRows = True
End Sub
'插入表格(专门适应工程结算工程量清单)
Public Sub InsertTableQD(ByRef table As DataTable, ByRef table1 As DataTable)
Dim oTable As Word.Table
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
Dim xmmc As String
Dim i As Integer
Dim j As Integer
rowIndex = 1
colIndex = 0

If (table.Rows.Count = 0) Then
Exit Sub
End If

NumRows = table.Rows.Count + 1
NumColumns = table.Columns.Count
'oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)


'初始化列
Dim Row As DataRow
Dim rowtemp As DataRow
Dim row1() As DataRow
Dim Col As DataColumn
Dim coltemp As DataColumn
'For Each Col In table.Columns
' colIndex = colIndex + 1
' oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
'Next

'将行添入表格
For Each Row In table.Rows
colIndex = 0
xmmc = Row( "项目名称 ")
GotoRightCell()
oWordApplic.Selection.InsertRows(1)
For Each Col In table.Columns
GotoRightCell()
Try
If (Col.ColumnName = "项目序号 ") Then
oWordApplic.Selection.TypeText(intToUpint(Val(Row(Col.ColumnName))))
Else
oWordApplic.Selection.TypeText(Row(Col.ColumnName))
End If
Catch ex As Exception
oWordApplic.Selection.TypeText( " ")
End Try
'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
row1 = table1.Select( "项目名称= ' " + xmmc + " ' ")

For i = 0 To row1.Length - 1
GotoRightCell()
oWordApplic.Selection.InsertRows(1)
For j = 0 To table1.Columns.Count - 1
If (table1.Columns(j).ColumnName <> "项目名称 ") Then
GotoRightCell()
Try
oWordApplic.Selection.TypeText(row1(i)(j))
Catch ex As Exception
oWordApplic.Selection.TypeText( " ")
End Try
End If
'oWordApplic.Selection.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
Next


Next
'删除可能多余的一行
'GotoRightCell()
'GotoDownCell()
'oWordApplic.Selection.Rows.Delete()
'oTable.AllowAutoFit = True
'oTable.ApplyStyleFirstColumn = True
'oTable.ApplyStyleHeadingRows = True
End Sub
'插入表格,为了满足要求,在中间添加一根竖线
Public Sub InsertTable3(ByRef table As DataTable, ByVal introw As Integer, ByVal intcol As Integer)
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
Dim Row As DataRow
Dim Col As DataColumn
If (table.Rows.Count = 0) Then
Exit Sub
End If
'首先是拆分选中的单元格
oDocument.Tables(1).Cell(introw, 3).Split(table.Rows.Count, 2)
'选中初始的单元格
oDocument.Tables(1).Cell(introw, 3).Select()
'将行添入表格
For Each Row In table.Rows


Try
oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter(Row(0))
oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter(Row(1))
Catch ex As Exception
oDocument.Tables(1).Cell(introw, 3).Range.InsertAfter( " ")
oDocument.Tables(1).Cell(introw, 4).Range.InsertAfter( " ")
End Try
introw = introw + 1
Next
End Sub
[解决办法]
简单示意一下:
Public Class Form1

Dim demo As New WordDemo
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
demo.AddDocument()
End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
demo.AddTable()
End Sub

Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
demo.SetTableFormat()
End Sub

Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click
demo.SetValue()
End Sub

Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click
demo.Quit()
End Sub
End Class

Public Class WordDemo
Private gWordApplication As Object
Private gDoc As Object
Private gRange As Object

Sub New()
gWordApplication = CreateObject( "WORD.Application ")

gWordApplication.Visible = True
End Sub

Public Sub AddDocument()
gDoc = gWordApplication.Documents.Add()
End Sub

Public Sub AddTable()
gDoc.Tables.Add(Range:=gDoc.Range(Start:=0, End:=0), NumRows:=4, NumColumns:=5)
End Sub

Public Sub SetTableFormat()
With gDoc.Tables(1)
gRange = gDoc.Range(.Cell(3, 1).Range.Start, .Cell(4, 1).Range.End)
gRange.Select()
gDoc.ActiveWindow.Selection.Cells.Merge()

gDoc.Range(.Cell(2, 1).Range.Start, .Cell(2, 5).Range.End).Cells.Merge()
gDoc.Range(.Cell(4, 2).Range.Start, .Cell(4, 5).Range.End).Cells.Merge()
.Cell(3, 1).VerticalAlignment = 1 'Const wdCellAlignVerticalCenter = 1
End With
End Sub

Public Sub SetValue()
With gDoc.Tables(1)
.Cell(1, 1).Range.InsertAfter( "A ")
.Cell(1, 2).Range.InsertAfter( "B ")
.Cell(1, 3).Range.InsertAfter( "C ")
.Cell(1, 4).Range.InsertAfter( "D ")
.Cell(1, 5).Range.InsertAfter( "E ")
.Cell(3, 1).Range.InsertAfter( "中国 ")
End With
End Sub

Public Sub Quit()
gWordApplication.Quit()
End Sub
End Class

读书人网 >VB Dotnet

热点推荐