摘 要：本文通过使用Office系列软件Word2007的VBA编程方法，在沅陵县农村土地承包经营权确权登记颁证工作（以下简称本项目）过程中，实现了文件重命名和排序自动化(OLE)以及文件打印自动化的工作任务，实现了文件批量打印输出，提高了工作效率。
关键词：农村土地承包经营权确权登记颁证工作；VBA编程方法；自动化(OLE)；批量打印
1 引言
农村土地承包经营权确权登记是一种物权登记。建立健全农村土地承包经营权登记制度，有利于保护农民的合法权利。通过农村土地承包经营权确权登记颁证工作，建立农村土地承包经营权数据库和信息系统，实现对农村土地承包经营权调查数据管理、土地承包合同管理、确权登记颁证管理和土地流转管理等功能，有利于维护农民合法权益，进一步落实了党的强农惠农政策，促进了农村社会稳定。
目前，全国农村土地承包经营权确权登记颁证工作已接近尾声，湖南省沅陵县农村土地承包经营权确权登记颁证工作也进入了成果汇交阶段。事实证明，这是一项测绘要求精准、工作情况和流程复杂、投入人力物力大的工作。在土地确权登记颁证成果汇交过程中，需要打印和整理大量的文档和图表资料，其中Word文档文件包括登记簿、申请书及土地承包合同，Excel表格文件包括归户表、地块调查表、承包方调查表。软件输出的成果文件在windows文件夹中的排列顺序通常是以文件名的第一个汉字的声母顺序或倒序排列（如图1所示），根据《湖南省农村土地承包经营权确权登记颁证档案管理实施办法》的要求，需要将农村土地承包经营权数据库软件输出的成果文件按登记簿、申请书、承包方调查表、地块调查表（内含两张表格）、归户表（内含两张表格）、承包合同的排序打印输出和整理，以利于工作开展，且成果整理要求承包合同打印4份，其他文档表格文件均需打印1份。这种打印整理工作任务虽然操作简单，但是若要人工打印和整理县本项目内的所有农户档案成果资料，工作量会非常大。因此，在湖南省沅陵县农村土地承包经营权确权登记颁证工作成果汇交中，项目急需解决的问题是：如何通过程序化的设计，高效实现每个农户档案文件夹的所有文件的文件名按要求自动排序，并以指定的数量在打印机上自动完成每份文件的打印输出。
.png)
2 VBA编程在本项目实例中的应用
VBA(Visual Basic For Application)是建立在office中一种应用程序开发工具，是一种类似于C、JAVA编程语言，利用VBA编程可以设计和扩展office系列软件的功能和效率。在湖南省沅陵县农村土地承包经营权确权登记颁证工作成果汇交中，该项目打印成果文档以发包方（村民小组）为单位，每个组级发包方文件夹中包含本组内所有的数量的承包方档案（农户档案）文件夹，每个农户档案文件夹中文件的排序如图1所示。本项目采用Office系列软件内置的VBA（Visual Basic for Applications）编程方法，拟通过编写VBA程序，以实现文件命名和排序自动化(OLE)和文件打印自动化，从而提高工作效率，节约工作人员的劳动时间并减少出错的概率。
程序设计的工作流程为：先设计用户浏览功能，浏览到存放发包方（村民小组）成果文件的工作文件夹中；然后通过程序设计，遍历浏览该文件夹及子文件夹中的所有文件，并逐一对不同名称的文件加上前缀，实现对每个农户档案文件夹下文件的重命名和排序（如图2所示）；再一次遍历浏览该文件夹及子文件夹中的所有文件，对每个农户档案文件夹下的所有文档按不同类型及打印份数调用相应的程序实现自动打印。
.png)
2.1 主程序设计
本项目实例的主程序拟在Word2007中的VBA编辑器中设计，首先在当前打开的Word文档中的发开工具菜单下，打开VBA编辑器，点击工具→引用，在弹出的对话框中选择Microsoft Excel 12.0 Object Library，以便在Word中调用Excel程序打印Excel表格。在VBA编辑器中，点击插入→过程，输入ZHZL_PrintFile作为本次打印主程序。主程序运行过程与设计整体工作流程一致，实现整个功能的主程序ZHZL_PrintFile清单如下（本文中程序里以单引号开头的文字均为注释说明）：
Public Sub ZHZL_PrintFile()
'定义存放工作目录的字符串变量Project_path ，保存用户指定的工作目录，由函数ReturnFolder返回值确定，如果返回值为空则退出程序
Dim Project_path As String
Project_path = ReturnFolder()
If Project_path = "" Then Exit Sub
'给参数变量Args不同的值，扫描工作目录文件后根据不同的参数调用不同的程序
'参数Args值为1时，调用重命名排序函数;参数值为2时，调用打印函数
Args = 1
Call GetFileList(Project_path)
Args = 2
Call GetFileList(Project_path)
'运行完毕关闭Excel和Word并退出
excelapp.Quit
Set excelapp = Nothing
Application.Quit
End Sub
其中参数Args声明为全局变量，在模块中声明如下：
Public Args As Integer
2.2 子程序设计
2.2.1文档扫描遍历浏览功能
本项目VBA编程中，程序设计需要对整个工作文件夹扫描遍历浏览两次，以实现文件先重命名和排序、后打印的功能。在此需把文档扫描遍历浏览功能做成通用的子程序，设置参数Args来控制文档扫描遍历浏览的次数，根据参数Args不同的值来调用不同功能的子程序。当扫描浏览到单个文件时，设置参数Args为1时，调用自定义命名函数Rename_file对文档重命名达到排序的目的；设置参数Args为2时，则调用自定义打印函数Print_file打印文档。
实现整个文档扫描功能子程序GetFileList如下：
Public Sub GetFileList(strFilepath As String)
'扫描遍历浏览某文件夹及子文件夹中的所有文件
Dim Myname As String
Dim a As String
Dim b() As String
Dim dir_i() As String
Dim i As Long
Dim idir As Long
If Right(strFilepath, 1) <>"\" Then strFilepath = strFilepath + "\"
Myname = Dir(strFilepath, vbDirectory Or vbNormal)
Do While Myname <>""
If Myname <>"." And Myname <>".." Then
If (GetAttr(strFilepath & Myname) And vbDirectory) = vbDirectory Then
'如果是目录，则继续在该目录下逐一搜索
idir = idir + 1
ReDim Preserve dir_i(idir) As String
dir_i(idir - 1) = Myname
Else
Select Case Args
Case 1
'参数Args为1时，调用命名排序函数对文件重命名
Call Rename_file(strFilepath, Myname)
Case 2
'参数Args为2时，调用打印函数打印文档
Call Print_file(strFilepath, Myname)
Case Else
Exit Sub
End Select
End If
End If
Myname = Dir '搜索下一项
Loop
For i = 0 To idir - 1
Call GetFileList(strFilepath + dir_i(i))
Next i
ReDim dir_i(0) As String
End Sub
2.2.2文件自动重命名和排序功能
在本项目实例中，拟实现每个农户档案文件夹的所有文件的文件名按要求自动排序，先用函数取出文件名字符串左边的3个位置，按登记簿、申请书、承包方调查表、地块调查表、归户表、承包合同的顺序分别加上A1、A2等前缀，实现与打印整理的顺序一致，以方便后续的工作需求。
实现相应文档重命名排序功能的子程序如下：
Private Sub Rename_file(filepath As String, filename As String)
'程序中的参数filepath、filename分别为打印文档的路径和文件名
'登记簿、申请书、承包方调查表、地块调查表、归户表、承包合同分别加上A1、A2等前缀后，文件按顺序排列与要打印的排列顺序一致
Select Case Left(filename, 3)
Case "登记簿"
Name filepath & filename As filepath &"A1"& filename
Case "申请书"
Name filepath & filename As filepath &"A2"& filename
Case "承包合"
Name filepath & filename As filepath &"A3"& filename
Case "归户表"
Name filepath & filename As filepath &"A4"& filename
Case "承包方"
Name filepath & filename As filepath &"A5"& filename
Case "地块调"
Name filepath & filename As filepath &"A6"& filename
End Select
End Sub
2.2.3 文档自动打印功能
本项目实例要实现文档自动打印功能，需调用通用子程序再次对所有文档逐一进行扫描，若扫描到Excel表格，则调用Excel程序打开文档，用函数控制“A4归户表”和“A6地块调查表”分别激活其内含的两张表格，并各打印1份、其他表格文件打印1份；若扫描到Word文档，则调用Word程序打开文档，其中承包合同打印4份、其他Word文档打印1份。
各文档调用相关软件打印功能的子程序如下：
Private Sub Print_file(filepath As String, filename As String)
If (LCase(Right(filename, 3)) = "xls" Or LCase(Right(filename, 4)) = "xlsx") Then
Excelapp.Workbooks.Open filename:=filepath & filename
If Left(filename, 4) = " A4归户" Or Left(filename, 4) = " A6地块" Then
'地块调查表和归户表有2张工作表，分别激活工作表1、工作表2各打印1份
Excelapp.Worksheets(1).Select
Excelapp.ActiveWindow.SelectedSheets.PrintOut Copies:=1
Excelapp.Worksheets(2).Select
Excelapp.ActiveWindow.SelectedSheets.PrintOut Copies:=1
Else
'其他Excel文档只有一张表打印1份
Excelapp.ActiveWindow.SelectedSheets.PrintOut Copies:=1
End If
Excelapp.ActiveWindow.Close (xlDoNotSaveChanges)
'打印完成后不保存关闭EXCEL文档
ElseIf LCase(Right(filename, 3)) = "doc" Or LCase(Right(filename, 4)) = "docx" Then
Documents.Open filename:=filepath & filename
If Left(filename, 4) = "A3承包" Then
'承包合同打印4份
Application.PrintOut Copies:=4
Else
'其他Word文档均只打印1份
Application.PrintOut Copies:=1
End If
ActiveWindow.Close
'打印完成后关闭文档
End If
End Sub
3 程序代码完善及用户界面的设定
创建EXCEL对象并赋值给变量Excelapp、用户指定工作目录的函数直接调用系统API，实现其功能的结构BROWSEINFO及返回值函数ReturnFolder均在模块起始位置作为全局变量和函数声明、定义。在模块起始位置中声明和定义的代码如下：
Option Explicit
'全局变量Args为整型
Public Args As Integer
'创建EXCEL对象并赋值给变量Excelapp
Dim Excelapp As New Excel.Application
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Public Const MAX_PATH = 2600
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Public Function ReturnFolder() As String
Dim Browser As BROWSEINFO
Dim lngFolder As Long
Dim strPath As String
With Browser
.hOwner = 0&
.lpszTitle = "选择工作目录..."
.pszDisplayName = String(MAX_PATH, 0)
End With
strPath = String(MAX_PATH, 0)
lngFolder = SHBrowseForFolder(Browser)
If lngFolder Then
SHGetPathFromIDList lngFolder, strPath
ReturnFolder = Left(strPath, InStr(strPath, vbNullChar) - 1)
End If
'返回用户选择的目录，如果用户不选择退出，则返回值为空
End Function
程序整体编写完成后，需设计该程序的用户界面以方便用户使用。在本项目实例中用命令按钮控件代替用户界面。在Word文档模式下点击开发工具→点击设计模式→点击控件命令按钮，在文档中添加命令按钮，将命令按钮移动到中间位置并设置适当的大小，右击属性将名称和标题均改为“批量打印程序”（如图3所示），双击“批量打印程序”按钮自动切换到代码窗口，在“批量打印程序_Click”事件中输入语句Call ZHZL_PrintFile，程序执行调用主程序的命令，至此整个程序编写完毕，将文件另存为启用宏的Word文档，以便下次使用。
.png)
4 程序共享
用户将带有打印程序的文档拷贝到任意安装有Oiffce2007软件的电脑上即可实现程序共享，用户在Oiffce系列软件打开带有打印程序的文档，点击“批量打印程序”命令按钮即可运行，运行效果如图4所示。本项目实例中，要打印的文档均可按指定的顺序排序及份数打印。
.png)
5 结语
经过本项目实践证明，使用Office系列软件Word2007的VBA编程方法创建的批量打印程序可以自动完成原来由手工设置和操作才能完成的打印工作，提高了工作效率。虽然目前测绘市场上已有很多批量打印程序，但因为这些程序对文档的打印有一定的局限（如只能全部文档统一打印份数、打印顺序固定等），不能满足农村土地承包经营权确权登记颁证工作中成果汇交阶段大批量成果档案打印和整理工作的要求，而使用Oiffce内置的VBA编程可以定制相应打印应用程序，实现了农村土地承包经营权确权登记颁证工作中成果档案文件排序自动化(OLE)和文件打印自动化的目的，满足了本项目的需求，提高了工作效率，同时也对相类似功能的程序设计具有一定的借鉴作用。
参考文献：
[1]崔晓宏.用VBA实现批量复制和打印任务[J]电脑编程技巧与维护,2010(21):86-88.
[2]谭浩强.Visual Basic程序设计［M］,北京:清华大学出版社,2004.