本文介绍了Word域与数据库结合的方法,给用户提供一个插入Word域的界面,并把数据库的数据填充到Word文件中。
域是Word中最具有实用价值的功能之一,它表示文档中可能发生变化的数据或邮件合并文档中套用信函、标签中的占位符。Microsoft Word 可以在您使用一些特定命令时插入域,如"插入"菜单上的"日期和时间"命令。您也可使用"插入"菜单上的"域"命令手动插入域。事实上,我们在日常工作中常会脱离Microsoft Word的操作环境。一般,用户是先建立好一些Word文件模板,然后利用所提供的应用程序功能向Word文件模板中插入域,用该域对应的值取代域值,这样就达到了向Microsoft Word文件中插入数据的作用。我们常把数据放入数据库中,数据库的内容不断地变化,我们的域值也跟着不断地变化,取到灵活自动更新的作用,要达到这方面的功能,就应该把数据库与Word域结合起来。
工程名称 | 设计阶段 | 工程检索号 | 项目名称 | 新制 | 字数 | 图片数 | |
建模工具 | 学习(2) | http://www.21cmm.com | fw-jm-2002 | 软件工程专家网 | 60 | 1000 | 3 |
序号 | 校核主要问题 | 执行情况 |
1 | 排列不齐 | No |
2 | 文字错 | Yes |
3 | 文字错 | Yes |
4 | 内容提要不详细 | No |
5 | 文字错 | Yes |
6 | 数据有误 | No |
利用VBA编写的一个通用的处理Word域的程序。开发步骤如下 :
1.建立项目,向项目中增加处理Word域的类
启动Visual Studio。NET。在新建项目中选择Visual Basic项目,在模板中选择Windows应用程序,把工程名更改为WordDoc。
● 向工程中增加名称为CWordDoc的类。
● 定义的CWordDoc类的属性。代码如下:
'定义Word应用对象及文档对象 Private wdApp As New Word..Application() Private wdDoc As New Word.Document() '所处理的Word模板文件 Private FileName As String '域的个数及对应的数组 Dim FieldCount As Int16 Dim MyField() 'Word是否已运行 Private IsWordRunning As Boolean '是否已经插入了表格行 Private IsInsertRow As Boolean 'Word工具栏对象及菜单栏对象数组 Dim CommandBarIndex() As Integer Dim SaveCommandBarMenuIndex() As Integer |
Public Sub OpenWordDocument(ByVal FileName As String) wdApp = CreateObject("Word。Application") wdApp.Documents。Open(FileName) wdDoc = wdApp.ActiveDocument wdDoc.ActiveWindow.DocumentMap = False wdApp.Visible = True IsWordRunning = True End Sub |
Public Sub SaveWordDocument() wdDoc.SaveAs(FileName) End Sub |
Public Sub SetWordSize(ByVal Left As Integer, ByVal top As Integer, ByVal width As Integer, ByVal height As Integer) wdApp。WindowState = Word.WdWindowState.wdWindowStateNormal wdApp。Left = Left wdApp。Top = top wdApp。Width = width wdApp。Height = height End Sub |
'在文档中插入域 'KeyWord:域的关键字 Public Function InsertField(ByVal KeyWord As String) As Integer Dim mySelection As Selection Dim Code As String Dim MyField As Field Dim myRange As Range wdApp。Selection。Collapse(Direction:=wdCollapseEnd) mySelection = wdApp。Selection '插入点 If KeyWord。Chars(KeyWord。Length - 1) = "F" Then If IsCell(mySelection) <> True Then MsgBox("该位置不是单元格,请选择单元格", vbOKOnly + vbExclamation) Exit Function End If End If If IsCell(mySelection) = True Then If CellFieldCount(mySelection) > 0 Then If MsgBox("该单元格已有域,是否覆盖?", vbYesNo) = 6 Then mySelection.Cells.Item(1).Select() mySelection.Delete() Else Exit Function End If End If End If MyField = wdDoc.Fields.Add(Range:=mySelection.Range, Type:=wdFieldAddin) MyField.Data = KeyWord End Function |
我们可以通过选择点的表格数判断插入点的性质。表格数为0,则选择点不位于单元格中,反则不位于单元格中。
'选择点(光标)是否是单元格。 Private Function IsCell(ByVal mySelection As Selection) As Boolean If mySelection.Tables.Count > 0 Then Return True Else Return False End If End Function '计算选择点(光标)的单元格的域数 Private Function CellFieldCount(ByVal mySelection As Selection) As Integer CellFieldCount = mySelection.Cells.Item(1).Range.Fields.Count End Function '记录插入域代码及关键字。这里主要是调用上面的InsertField方法。 Public Function InsertFieldByKeyWord(ByVal KeyWord As String) As Integer Dim ID As Integer FieldCount = FieldCount + 1 ReDim MyField(FieldCount) ID = InsertField(KeyWord) MyField(FieldCount).ID = ID MyField(FieldCount).KeyWord = KeyWord End Function |
当Word文件已经插入了域,就要填充域值。填充域值应该分为二种情况考虑。一种是单值域,一种是多值域。单值域是一一对应关系,仅取出值域插入到对应的位置。实现的方法是扫描整个文档,找出是用户插入的域(Fields.Type = 81),用域值取代之,这里用到了一个由关键字得到值的方法GetFieldValues,这个方法在后面将会讲到,对应的是数据库的"工程"表。怎样保证永远仅插入一个值呢?方法是先清除掉原域值和域代码,再在当前插入点插入域代码和域值。实现的方法如下:
'用关键字对应的值插入值,在文档中在有域的地方插入对应的值 Public Function InsertValue() As Boolean Dim i, Count As Integer Dim KeyWord As String Dim Value, Data Dim mySelection As Selection Count = wdDoc.Fields.Count For i = 1 To Count If wdDoc.Fields.Item(i).Type = 81 Then KeyWord = wdDoc.Fields.Item(i).Data If Right(KeyWord, 1) <> "F" Then Value = clsDB.GetFieldValues("工程", KeyWord) wdDoc.Fields.Item(i).Select() mySelection = wdApp.Selection '插入点 If mySelection.Tables.Count <> 0 Then 'clear text mySelection.Cells.Item(1).Select() mySelection.Delete() '还原原域 InsertField(KeyWord) End If wdDoc.Fields.Item(i).Result.Text = Value(0).itemarray(0) End If End If Next End Function |
'插入多值域 Public Function InsertCollection() As Boolean Dim i, j, Count As Integer Dim KeyWord As String Dim mySelection As Selection Dim rec() As Object Dim recCount As Integer Count = wdDoc.Fields.Count For i = 1 To Count If wdDoc.Fields.Item(i).Type = 81 Then KeyWord = Trim(wdDoc.Fields.Item(i).Data) If Right(KeyWord, 1) = "F" Then KeyWord = Left(KeyWord, Len(KeyWord) - 1) rec = clsDB.GetFieldValues("校核", KeyWord) '选择有域的单元格 wdDoc.Fields.Item(i).Select() mySelection = wdApp.Selection '插入点 mySelection.Cells.Item(1).Select() '清除原值 mySelection.Delete() '还原原域并更新值 InsertField(KeyWord + "F") wdDoc.Fields.Item(i).Result.Text = rec(0).itemarray(0) '光标下移 mySelection.Select() mySelection.MoveDown(Unit:=wdLine, Count:=1) With rec recCount =.GetLength(0) - 1 For j = 1 To recCount - 1 If IsInsertRow = False Then Call InsertRow(mySelection, recCount) End If mySelection.Cells.Item(1).Select() mySelection.Delete() mySelection.TypeText(Text:=rec(j).itemarray(0)) mySelection.MoveDown(Unit:=wdLine, Count:=1) Next End With End If End If Next End Function Private Function InsertRow(ByVal mySelection As Selection, ByVal recCount As Integer) As Boolean Dim InsertRowCount As Integer '插入的行数 Dim CurrCell As Cell CurrCell = mySelection.Cells.Item(1) InsertRowCount = recCount - mySelection.Tables.Item(1).Rows.Count + 1 If InsertRowCount > 0 Then mySelection.InsertRows(InsertRowCount) CurrCell.Select() mySelection.MoveUp(Unit:=wdLine, Count:=InsertRowCount) IsInsertRow = True End If End Function |
如果表格行数少于表数据的行数则应该增加表格行数。增加多少表格行数由表数据的行数减去现有表格行数加入计算出来。当插入了行,光标一定下移了几行,这里要还原光标至原来位置,方法是先保留插入点,插入行后,重新选择插入点,使光标上移几行。表格已经插入行以后就不要再插入了,所以至IsInsertRow为真。
'向表格中增加行数。 Private Function IsInsert(ByVal mySelection As Selection, ByVal recCount As Integer) As Boolean Dim InsertRowCount As Integer '插入的行数 Dim CurrCell As Cell CurrCell = mySelection.Cells.Item(1) InsertRowCount = recCount - mySelection.Tables.Item(1).Rows.Count + 1 If InsertRowCount > 0 Then mySelection.InsertRows(InsertRowCount) CurrCell.Select() mySelection.MoveUp(Unit:=wdLine, Count:=InsertRowCount) IsInsertRow = True End If End Function |
'恢复Word环境的所有命令及菜单。 Public Sub OpenCommandBar() Dim i As Integer For i = 0 To UBound(CommandBarIndex) - 1 wdDoc.CommandBars(i + 1).Visible = True Next For i = 0 To UBound(SaveCommandBarMenuIndex) - 1 wdDoc.CommandBars.Item("Menu Bar").Controls(i + 1)。Visible = True Next End Sub '关闭Word环境的所有命令及菜单。 Public Sub CloseCommandBar() Dim i As Integer Dim cBar ReDim CommandBarIndex(1) ReDim SaveCommandBarMenuIndex(1) i = 0 For Each cBar In wdDoc.CommandBars If cBar.Type = 0 And cBar.Enabled = True Then If cBar.Visible = True Then ReDim CommandBarIndex(i + 1) CommandBarIndex(i) = cBar.Index i = i + 1 cBar.Visible = False End If End If Next i = 0 For Each cBar In wdDoc.CommandBars("Menu Bar").Controls If cBar.Visible = True Then ReDim SaveCommandBarMenuIndex(i + 1) SaveCommandBarMenuIndex(i) = cBar.Index i = i + 1 cBar.Visible = False End If Next End Sub |
2.增加一个处理数据库的类COleDataAccess。
COleDataAccess类很简单,包含连接数据库的方法ConnAccess,打开静态表的方法GetDataTable,由字段名得到字段值的方法GetFieldValues。
Public Class COleDataAccess Private mOleCnnDB As New OleDbConnection() '连接Access数据库:DBName数据库名。 Public Sub ConnAccess(ByVal DBName As String) mOleCnnDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Password=""" ";User ID=Admin;" &#38; _ "Data Source='" &#38; DBName &#38; "'" mOleCnnDB.Open() End Sub '获取数据表.strSql查询条件。 Public Overloads Function GetDataTable(ByVal strSql As String) As DataTable Dim myDataSet As New DataSet() Dim myOleDataAdapter As New OleDbDataAdapter() myOleDataAdapter.SelectCommand = New OleDbCommand(strSql, mOleCnnDB) Try myOleDataAdapter.Fill(myDataSet) Catch er As Exception MsgBox(er.ToString) End Try Return myDataSet.Tables(0) End Function '由字段名得到字段值的方法:. TableName表名 ; FieldName 字段名 Public Overloads Function GetFieldValues(ByVal TableName As String, ByVal FieldName As String) As Object() Dim dr As DataTable Dim sql As String sql = "select " + FieldName + " from " + TableName dr = GetDataTable(sql) Dim al(dr.Rows.Count) As Object dr.Rows.CopyTo(al, 0) Return al End Function End Class |
3.增加模块Module1
模块Module1定义COleDataAccess类的变量clsDB,并连接数据库,显示用户窗体。
Module Module1 Public clsDB As New COleDataAccess() Sub main() clsDB.ConnAccess("工程数据。mdb") Dim frm As New frmUserWord() frm.ShowDialog() End Sub End Module |
4.增加用户操作窗体
向工程中增加一窗体frmUserWord,窗体标题为"处理Word文档",在frmUserWord上加入3个CommandButton,用于打开文件(cmdOpenFile)、填充数据(cmdFill)、保存文件(cmdSave)用的命令按钮;2个ComboBox,用于所插入的字段名;2个 Label;2个CommonDialog,用于执行打开文件和保存文件;打开文件的对话框OpenFileDialog1、保存文件的对话框SaveFileDialog1。界面如下:
Public Class frmUserWord Inherits System.Windows.Forms.Form Dim clsDoc As New CWordDoc() '打开Word文件。并使处理界面位于Word最顶端,适当调整Word位置,关闭Word其它功能。 Private Sub cmdOpenFile_Click(ByVal sender As System。Object, ByVal e As System。EventArgs) Handles cmdOpenFile。Click Dim FileName As String OpenFileDialog1.ShowDialog() FileName = OpenFileDialog1.FileName If FileName = "" Then Exit Sub End If clsDoc.OpenWordDocument(FileName) clsDoc.SetWordSize(0, 50, 2000, 2000) clsDoc.CloseCommandBar() Me.Top = 0 Me.Left = 0 Me.Width = 10000 Me.Height = 80 ComboBox1.Enabled = True ComboBox2.Enabled = True cmdSave.Enabled = True cmdFill.Enabled = True End Sub |
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load Dim i As Integer OpenFileDialog1.Title = "打开文件" OpenFileDialog1.Filter = "Word文档(*.doc)|*.doc|Word文档模板(*.dot)|*.dot" SaveFileDialog1.Title = "保存文件" SaveFileDialog1.Filter = "Word文档(*.doc)|*.doc|Word文档模板(*.dot)|*.dot" Dim dt As New DataTable() dt = clsDB.GetDataTable("select * from 工程") For i = 0 To dt.Columns.Count - 1 ComboBox1.Items.Add(dt.Columns.Item(i).ColumnName) Next dt = clsDB.GetDataTable("select * from 校核") For i = 0 To dt.Columns.Count - 1 ComboBox2.Items.Add(dt.Columns.Item(i).ColumnName) Next End Sub '填充数据 Private Sub cmdFill_Click(ByVal sender As System.Object, ByVal e As System。EventArgs) Handles cmdFill.Click clsDoc.InsertValue() clsDoc.InsertCollection() End Sub '用户选择所插入域的域名,并在光标处插入单值域。 Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged clsDoc.InsertField(sender.Text) End Sub '用户选择所插入域的域名,并在光标处插入多值域。 域所对应多值时,域只能插入表格中。且要与单值域区分,标记为多值插入。 Private Sub ComboBox2_SelectedValueChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles ComboBox2.SelectedValueChanged Dim KeyWord As String KeyWord = sender.Text + "F" '标记是多值 clsDoc.InsertField(KeyWord) End Sub '保存Word文件。 Private Sub cmdSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdSave.Click clsDoc.SaveWordDocument() End Sub '打开Word的命令菜单及工具箱。 Private Sub frmUserWord_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed clsDoc.OpenCommandBar() End Sub End Class |
打开一Word文件运行后的界面如下:
欢迎访问最专业的网吧论坛,无盘论坛,网吧经营,网咖管理,网吧专业论坛
https://bbs.txwb.com
关注天下网吧微信/下载天下网吧APP/天下网吧小程序,一起来超精彩
|
本文来源:vczx 作者:佚名