注册 登录
编程论坛 VB6论坛

[开源]VB操作WORD.

随风逐流 发布于 2007-10-25 14:22, 14155 次点击

对其WORD内容设置字体样式.
在WORD中插入表格,以及表格单元格融合与填充.
以下代码在如要在中文系统下运行。将"表 (格子) "换成"网格型"

Option Explicit

Private Sub Command1_Click()
Dim filename As String
CD.ShowSave
filename = CD.filename
OutWord filename
MsgBox "OK"
End Sub

Private Function OutWord(ByVal filePath As String) As Boolean
Dim newDoc As Word.Document
Set newDoc = New Word.Document

With newDoc
.Paragraphs(.Paragraphs.Count).Range.Font.Name = "宋体"
.Paragraphs(.Paragraphs.Count).Range.Font.Size = 10.5
.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphRight
.Content.InsertAfter "編号:" & vbCrLf

.Paragraphs(.Paragraphs.Count).Range.Font.Name = "宋体"
.Paragraphs(.Paragraphs.Count).Range.Font.Size = 26
.Paragraphs(.Paragraphs.Count).Range.Font.Bold = True
.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphCenter
.Content.InsertAfter vbCrLf & "XXXXXXXXX報告" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf

.Paragraphs(.Paragraphs.Count).Range.Font.Name = "宋体"
.Paragraphs(.Paragraphs.Count).Range.Font.Size = 15
.Paragraphs(.Paragraphs.Count).Range.Font.Bold = False
.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphLeft
.Content.InsertAfter "项目名称:" & vbCrLf
.Content.InsertAfter "应急类型:" & vbCrLf
.Content.InsertAfter "预警状态:正常/警界/危机" & vbCrLf

.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphCenter
.Tables.Add Range:=.Range(Start:=.Range.End - 1, End:=.Range.End), NumRows:=1, NumColumns:=3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
With .Tables(1)
If .Style <> "表 (格子)" Then
.Style = "表 (格子)"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Columns.Width = 50
.Rows.Height = 20
End With

.Paragraphs(.Paragraphs.Count).Range.Font.Name = "宋体"
.Paragraphs(.Paragraphs.Count).Range.Font.Size = 15
.Paragraphs(.Paragraphs.Count).Range.Font.Bold = False
.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphLeft
.Content.InsertAfter "委 托 人:" & vbCrLf
.Content.InsertAfter "预 警 机 构:" & vbCrLf
.Content.InsertAfter "报告负责人:" & vbCrLf
.Content.InsertAfter "时 间:" & vbCrLf

.Paragraphs(.Paragraphs.Count).Alignment = wdAlignParagraphLeft
.Tables.Add Range:=.Range(Start:=.Range.End - 1, End:=.Range.End), NumRows:=8, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
With .Tables(2)
If .Style <> "表 (格子)" Then
.Style = "表 (格子)"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
.Cell(2, 1).Range.Text = "项目名称"
.Range.Cells(3).Row.Cells.Merge
.Range.Cells(3).Range.Font.Size = 15
.Range.Cells(3).Range.Text = "信息来源/文献检索范围:" & vbCrLf & vbCrLf & vbCrLf
.Range.Cells(4).Row.Cells.Merge
.Range.Cells(4).Range.Text = "情况描述/检索结果:" & vbCrLf & vbCrLf & vbCrLf
.Range.Cells(5).Row.Cells.Merge
.Range.Cells(5).Range.Text = "影响分析:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf
.Range.Cells(6).Row.Cells.Merge
.Range.Cells(6).Range.Text = "建议:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
.Range.Cells(7).Row.Cells.Merge
.Range.Cells(7).Range.Text = "专家组成员:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
.Range.Cells(8).Row.Cells.Merge
.Range.Cells(8).Range.Text = "附件目录:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf
.Range.Cells(9).Row.Cells.Merge
.Range.Cells(9).Range.Text = "报告负责人:" & vbCrLf & vbCrLf & vbCrLf & vbCrLf & " 年 月 日"
End With

End With

newDoc.SaveAs filePath
newDoc.Close
End Function

[此贴子已经被作者于2007-10-25 21:23:28编辑过]

57 回复
#52
brambleszp2010-10-28 10:02
我狂顶,好东西,找了很久了。
#53
zxj7106272011-06-16 14:24
是好东西,但现在没有时间试这些了。
#54
epswxh2011-11-26 10:30
希望不久我可以应用它,
#55
cn_daiminyu2012-02-10 16:50
表 (格子)  改成 网格型
#56
lzm2012-09-14 17:30
Excel的写过,可没想到你能写WORD的,太牛了!
#57
leavel3022012-12-31 13:39
顶一下!不能只是索取没有奉献。
#58
leavel3022012-12-31 14:15
表格怎么另起一行呢???
12