巧用VBA编程实现EXCEL电子表格的批量自动打印

使用 VBA 实现自动打印功能自动打印功能是一项非常方便的功能，可以使我们的工作更高效。

VBA（Visual Basic for Applications）是一种用于自动化和自定义Microsoft Office应用程序的编程语言。

在本文中，我们将探讨如何使用VBA实现自动打印功能。

首先，我们需要打开Microsoft Office应用程序，例如Microsoft Word或Microsoft Excel。

接下来，我们将编写一段简单的VBA代码，以便在特定条件下自动执行打印操作。

在VBA编辑器中，我们可以在需要实现打印功能的模块内编写以下代码：```Sub AutoPrint()Dim ws As WorksheetSet ws = ThisWorkbook.ActiveSheet' 定义打印的区域Dim printRange As RangeSet printRange = ws.Range("A1:E10") ' 设置打印属性With ws.PageSetup.PrintArea = printRange.Address.Orientation = xlPortrait.FitToPagesWide = 1.FitToPagesTall = FalseEnd With' 打印ws.PrintOut' 清除打印设置ws.PageSetup.PrintArea = ""End Sub```以上代码使用了Excel的对象模型来实现自动打印功能。

首先，我们在代码中定义了一个名为`AutoPrint`的子程序。

在这个子程序中，我们首先设置了当前活动的工作表对象，使用`ThisWorkbook.ActiveSheet`来获取当前工作表。

接下来，我们设置了需要打印的区域，以A1到E10作为示例。

您可以根据实际需求更改打印区域。

在代码的第11行，我们使用`ws.Range("A1:E10")`将要打印的区域赋值给了`printRange`对象。

巧用VBA编程实现EXCEL证件的批量打印夏教荣陈文涛（湖南省邵阳县白仓镇中学421114）摘要介绍了在EXCEL中如何使用VBA,通过实例论述了在EXCEL中可以通过VBA编程实现含有照片的电子证件或表格批量自动打印，提高了EXCEL在实际应用中的工作效率及节省人力资源。

关键词VBA编程自动打印EXCEL一VBA简介1、什么是VBA？VBA是Visual Basic For Application的缩写，它是以Visual Basic为发展基础的语言。

在Office软件中，VBA应用程序能够在Word、Access、Excel等之间进行交互式应用，加强了应用程序间的互动。

VBA是VB的应用程序版本，可以理解为“寄生在Office办公软件中的VB”，可以看作是VB语言的一个子集。

VBA使Office形成了独立的编程环境。

2、VBA与Visual Basic的关系1）、VB用于开发Windows应用程序，其代码最终被编译为可执行程序。

而VBA是用于控制已有应用程序的自动化操作，其代码为解释。

2）、VB拥有独立的开发环境，而VBA必须集成在已有的应用程序中(Excel等)。

3）、VB开发出来的应用程序在脱离开发环境后仍能执行，而VBA编写出来的程序必须在访问集成应用程序(Excel等)的基础上进行。

尽管有以上不同，但它们仍然非常相似。

都使用相同的语言结构。

两者的程序的语法及程序流程完全一样。

二、在Excel中使用VBA1、进入VBA的方法下面以Office2010为例说明来进入VBA的方法：功能区中有一个“开发工具”选项卡，在此可以访问 Visual Basic 编辑器和其他开发人员工具。

由于 Office 2010 在默认情况下不显示“开发工具”选项卡，因此必须使用以下过程启用该选项卡：1）、在“文件”选项卡上，选择“选项”打开“Excel 选项”对话框。

2）、单击该对话框左侧的“自定义功能区”。

利用VBA实现自动打印报表自动化报表打印是许多企业和机构所面临的一个重要任务。

为了提高工作效率和准确性，利用VBA（Visual Basic for Applications）编程语言可以实现报表的自动打印和批量处理。

本文将介绍如何使用VBA编写自动打印报表的程序。

一、编写VBA代码前的准备工作在开始编写VBA代码之前，我们需要确保计算机已安装Microsoft Office 套件，并打开需要进行自动打印报表的Excel文件。

在Excel文件中，我们需要确保报表数据已准备好，并已按照需要的样式进行整理。

二、进入VBA编辑器在Excel文件中，按下“Alt”和“F11”键，即可打开VBA编辑器界面。

在左侧的项目窗格中，双击需要编写代码的工作表（Sheet）或工作簿（Workbook）。

三、编写VBA代码1. 设置打印区域：在VBA编辑器中的代码窗格中，输入以下代码：```vbaSub SetPrintArea()Dim ws As WorksheetSet ws = ThisWorkbook.Worksheets("Sheet1") '替换为需要打印的工作表名With ws.PageSetup.PrintArea = .UsedRange.AddressEnd WithEnd Sub```上述代码中，“Sheet1”是需要打印的工作表名称，你可以根据实际情况进行替换。

2. 自动打印报表：在VBA编辑器中的代码窗格中，输入以下代码：```vbaSub AutoPrint()Dim ws As WorksheetDim LastRow As LongDim i As LongSet ws = ThisWorkbook.Worksheets("Sheet1") '替换为需要打印的工作表名LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).RowWith wsFor i = 1 To LastRowIf .Cells(i, 1).Value <> "" Then.PrintOut '直接打印当前工作表End IfNext iEnd WithEnd Sub```上述代码中，“Sheet1”是需要打印的工作表名称，请根据实际情况进行替换。

excel怎么利⽤vba实现批量套打快递单批量打印单据？excel vba 批量套打快递单,批量打印单据，可以⾃定义修改设置新的格式。

1、设置快递单的⾃定义纸张。

选择对应打印机-点击打印服务器属性-勾选创建新表单-输⼊表单名称-填写对应尺⼨-点击保存表单（快递单的⾼度=1.27cm×边孔数量）2、设置纸张规格。

选择对应打印机-右键点击打印⾸选项-打开⾼级选项卡-纸张规格选择新增的⾃定义纸张3、设置进纸规格。

选择对应打印机-右键点击属性-打开设备设置-进纸器选择新增的⾃定义纸张4、下载快递套打模板。

测试打印根据实际的偏移情况进⾏调整设置，调整边距和缩放⽐例点击设置打印边距；1、打印明细字段名修改⽅法1）修改【打印明细】字段名，也可以变化前后顺序，不需要的字段也可以删除。

2）同步修改【参数】表内D列对应的名称。

3）E列是⾃动更新不⽤更新2、新增调整修改打印字段位置⽅法1）在【参数】内A列添加或者修改字段名，⾃定义⾃⼰明⽩即可。

2）在【参数】内B列添加此字段在【打印模板】对应⾏数。

3）在【参数】内C列添加此字段在【打印模板】对应列数。

4，在【参数】内D列添加此字段在【打印明细】对应表头字段名。

3、设置新的打印模板1）【打印模板】可以删除背景，添加新的快递单背景，或者设置需要打印的表单。

2）设置完毕新的格式后设置新的打印区域。

3）修改【参数】内各字段对应数据。

4、具体VBA编程如下，复制内容到剪贴板Private Sub 打印全部数据_Click()config = vbYesNo + vbQuestion + vbDefaultButton1ans = MsgBox("你确认打印全部数据吗？", config, "如风达")If ans = vbYes ThenDim A&, B&, C&, D$, E$,R1&, C1&, R2&, C2&, R3&, C3&, R4&, C4&, SF$'当前⼯作表名SF = '打印明细的最后列,⾏R1 = Sheets("打印明细").UsedRange.Rows.CountC1 = Sheets("打印明细").UsedRange.Columns.Count'参数的最后列,⾏R2 = Sheets("参数").UsedRange.Rows.CountC2 = Sheets("参数").UsedRange.Columns.Count'更新打印位置对应列For B = 2 To R2Sheets("参数").Cells(B, 5) = ""For A = 1 To C1If Sheets("参数").Cells(B, 4).Text = Sheets("打印明细").Cells(1, A).Text ThenSheets("参数").Cells(B, 5) = AEnd IfNextNext'查询指定订单的信息For R4 = 2 To R1For A = 2 To R2If Sheets("参数").Cells(A, 5).Text <> "" Then'⽣成明细列C4 = Sheets("参数").Cells(A, 5).Text'⽣成⽬标对应⾏列R3 = Sheets("参数").Cells(A, 2).TextC3 = Sheets("参数").Cells(A, 3).TextActiveSheet.Cells(R3, C3).Value = Sheets("打印明细").Cells(R4, C4).Text End IfNextActiveSheet.PrintOut From:=1, To:=1NextMsgBox "打印完成！", vbInformationIf ans = vbNo ThenExit SubEnd IfEnd IfEnd Sub。

Excel之VBA常用功能应用篇：用VBA在EXCEL里实现标签的批量打印相信很多小伙伴曾经也跟我一样遇到类似的问题：如何让一些数据能够自动填充到指定栏并自动打印出来，类似的实现方式比如邮件合并啊，虚拟打印啊，有好几种，今天我给大家介绍如何用vba来实现。

事情的起因是需要打一批产品标签，大家知道标签格式都是固定的，但是每一件毛重净重会有微小的变化，如果靠人工来改一个打一张，实在效率低下，那我的目标就是做一个简单vba来循环，填充数据-》打印-》填充下一列数据-》打印。

那怎么来实现呢？下面我教大家一步步来。

A。

首先，我们要在excel里开启vba功能，这个默认是关闭的，因为vba本身是个程序，以前曾经很流行vba病毒。

下面的步骤是我百度复制来的，如果看不懂的盆友可以直接百度经验。

1，打开Excel软件，点击左上角的文件菜单2，选择左下角的选项菜单3，选择自动以功能区的开发工具4，点击顶部的开发工具菜单5，点击Visual Basic按钮6，这样就打开了VBA的编辑区域B。

好了，vba我们先放一放，我们先把标签页和数据页建立起来。

图3然后按自己需要的格式编辑好，我自己的弄完以后大概是这个样子，那个红色格子都是醒目作用，打印的时候是不需要的哈图4所有我标红色的格子，都是需要自动更新数据的地方，下面重要部分来了大家注意看！我们需要用一个函数来实现这个功能，否则第一步自动更新数据我们就做不下去了，对不对。

记住这个函数，offset，这个函数根据引用的数据来做参照计算，比如其中有个L6-2，这个什么意思呢，引用L2栏内的数据来做计算图5比如图4中，L6栏的序号是124，这个意思就是我需要引用数据页中第124行的数据来填充到这个标签内，而在=OFFSET(数据页!$A$2,L6-2,5)这个函数内，数据页!$A$2表示引用数据页这个sheet中的数据，L6-2则表示引用哪一行，最后一个5表示这一行中的第几个数据。

使用VBA快速批量处理Excel文件Excel是一款广泛应用于数据处理和分析的电子表格软件。

借助于Visual Basic for Applications（VBA），用户可以利用编程语言来扩展Excel的功能，使其具备自动化处理大量数据的能力。

本文将介绍如何使用VBA快速批量处理Excel文件，从而提高工作效率和准确性。

首先，我们需要打开Excel，并进入VBA编辑器。

按下Alt+F11或在菜单栏选择“开发工具”-“Visual Basic”即可进入VBA编辑器界面。

1. 批量处理工作簿在VBA编辑器中，我们可以编写宏（Macro）来批量处理工作簿。

宏是一系列动作和命令的集合，可以自动执行这些操作，从而避免重复工作。

以下是一个示例，演示如何批量保存所有打开的工作簿：```vbaSub SaveAllWorkbooks()Dim wb As WorkbookFor Each wb In Workbookswb.SaveNext wbEnd Sub```在VBA编辑器中，将上述代码粘贴到一个新的模块中。

然后按下F5或在菜单栏选择“运行”-“运行宏”，即可批量保存所有打开的工作簿。

2. 批量处理工作表类似于批量处理工作簿，我们也可以编写宏来批量处理工作表。

以下是一个示例，演示如何批量删除所有工作表中的空行：```vbaSub RemoveEmptyRows()Dim ws As WorksheetDim lastRow As LongDim i As LongFor Each ws In WorksheetslastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For i = lastRow To 1 Step -1If WorksheetFunction.CountA(ws.Rows(i)) = 0 Then ws.Rows(i).DeleteEnd IfNext iNext wsEnd Sub```在VBA编辑器中，将上述代码粘贴到一个新的模块中。

VBA实现Excel的批量处理与循环操作在日常工作中，我们经常需要处理大量的数据，而手动逐个操作显然是非常耗时且低效的。

VBA（Visual Basic for Applications）是一种编程语言，可以在Microsoft Office应用程序中进行自动化操作，极大地提高了工作效率。

在Excel中，我们可以利用VBA的强大功能，实现批量处理与循环操作，从而大幅度减少重复工作的时间和精力。

一、批量处理数据1. 打开Excel文件并设置工作表在VBA中，我们可以使用Workbooks.Open方法打开Excel文件，并使用Worksheets对象设置工作表。

例如，下面的代码将打开名为"Data.xlsx"的Excel文件，并将其第一个工作表设置为活动工作表。

```vbaDim wb As WorkbookDim ws As WorksheetSet wb = Workbooks.Open("C:\Data.xlsx")Set ws = wb.Worksheets(1)ws.Activate```2. 循环处理数据在Excel中，我们经常需要对多个行或列进行相同的操作，这时就可以使用循环来批量处理数据。

在VBA中，最常用的循环结构是For循环和Do While循环。

例如，下面的代码将对A列中的所有单元格进行遍历，并在每个单元格中添加前缀"Processed_"：```vbaDim lastRow As LongDim i As LonglastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).RowFor i = 1 To lastRowws.Cells(i, "A").Value = "Processed_" & ws.Cells(i, "A").Value Next i```3. 批量处理数据的其他方法除了使用循环进行批量处理外，VBA还提供了其他一些方法来快速处理数据。

ExcelVBA编程与宏自动导出如何设定宏的自动导出和批量导出Excel VBA编程与宏自动导出Excel是一种常用的电子表格软件，而VBA（Visual Basic for Applications）是一种用于自动化任务的编程语言。

在Excel中，VBA 编程可以帮助用户实现各种功能，其中包括自动导出和批量导出，以提高工作效率。

一、VBA宏的基础概念在开始讨论如何设定宏的自动导出和批量导出之前，我们首先需要了解一些VBA宏的基础概念。

1. VBA宏是什么？VBA宏是由一系列VBA代码组成的程序，可以在Excel中执行特定的任务或操作。

2. VBA编辑器VBA编辑器是用于创建、编辑和管理VBA宏的工具。

您可以通过按下Alt + F11键来打开VBA编辑器。

3. 宏录制器宏录制器是VBA编辑器中的一个功能，允许您录制和执行特定的操作，然后将其保存为VBA宏。

二、如何设定宏的自动导出1. 打开VBA编辑器按下Alt + F11键来打开VBA编辑器。

2. 创建一个新的VBA宏在VBA编辑器中，选择“插入” -> “模块”，然后在模块中编写您的VBA代码。

您可以按照下面的示例代码编写自动导出的宏：```VBASub AutoExport()' 定义变量Dim FilePath As StringDim FileName As String' 设置保存路径和文件名称FilePath = "C:\Exports\" ' 指定导出文件保存路径FileName = "Export_" & Format(Now(), "yyyymmddhhmmss") & ".xlsx" ' 自动生成文件名' 执行导出操作ActiveSheet.SaveAs FilePath & FileNameEnd Sub```3. 设定自动触发事件为了将宏设定为自动导出，可以使用Excel的事件触发器。

办公小技巧：如何用excelVBA实现批量筛选打印表格
办公人员每天都要跟电脑打交道，用的最多的软件是office。

其中word用的最为广泛，公文打印必不可少，ppt会议演示用的最多，excel表格财务部门必备。

这里要说的是excel最常用的操作，筛选打印表格。

举个例子，根据姓名打印每个学生的成绩
正常的操作步骤是：
1、用excel打开表格，点击数据筛选，在姓名字段选择名字打印
excel实现批量筛选打印
2、根据不同姓名重复上面的筛选打印步骤。

对于上面的操作步骤，在姓名数量不多的情况下，是简洁快速的。

如果学生数量达到成千上百，再用这种手工方式来筛选打印很费时费力。

这里介绍个小技巧，用excel自带的VBA来实现批量筛选打印，可以达到事半功倍的效果。

1、用excel打开表格，在G列把所有的姓名填好，注意不要有重复的。

excel实现批量筛选打印
2、按alt+F11打开VBA工程界面，在工程界面新建模块，然后在代码区域输入下面的代码：
excel vba实现批量筛选打印
保存后，按F5运行，注意在这之前要先把打印机设置好。

用excel实现批量筛选打印，有多种方法，这里介绍了一种用vba 代码实现的方法，自由度比较高。

自己用VBA编的批量打印程序（原创）Option Explicit'图形集合Private colDwgs As New Collection'文档对象Dim objDoc As AcadDocument'布局对象Dim objLayout As AcadLayout'打印对象Dim objPlot As AcadPlotPrivate Type BrowseInfohOwner As LongpidlRoot As LongpszDisplayName As StringlpszTitle As StringulFlags As Longlpfn As LonglParam As LongiImage As LongEnd TypePrivate Const MAX_PATH = 260'代表ESC键Private Const VK_ESCAPE = &H1B'API函数的声明Private Declare Function SHBrowseForFolder Lib "shell32.dll" _Alias "SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) As LongPrivate Declare Function FindWindow Lib "user32" Alias"FindWindowA" (ByVal lpClassName As String, _ByVal lpWindowName As String) As LongPrivate Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal _pidl As Long, ByVal pszPath As String) As LongPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer' 功能：判断用户是否按下某一个键' 输入：代表键的常量（从API Viewer中获得）' 调用：API函数GetAsyncKeyState' 返回：如果用户按下了指定的键，返回True；否则返回False' 示例：' If CheckKey(&H1B) = True Then do sthPrivate Function CheckKey(lngKey As Long) As BooleanIf GetAsyncKeyState(lngKey) ThenCheckKey = TrueElseCheckKey = FalseEnd IfEnd FunctionPrivate Sub cboPaperSize_Change()'若组合框非空If cboPaperSize.Text <> "" Then' 设置图纸尺寸objLayout.CanonicalMediaName = cboPaperSize.Text' 显示图纸尺寸Call SetPlotZoneEnd IfEnd SubPrivate Sub cboPlotScale_Click()If cboPlotScale.Value TheneStandardScale = True '使用标准打印比例ElseeStandardScale = False '使用自定义打印比例End IfSelect Case cboPlotScale.ValueCase 0'txtNumerator = 1'txtDenominator = 1Case 1objLayout.StandardScale = acScaleToFit txtNumerator = 1txtDenominator = ""Case 2objLayout.StandardScale = ac1_1txtNumerator = 1txtDenominator = 1Case 3objLayout.StandardScale = ac1_2txtNumerator = 1txtDenominator = 2Case 4objLayout.StandardScale = ac1_4txtNumerator = 1txtDenominator = 4Case 5objLayout.StandardScale = ac1_8txtNumerator = 1txtDenominator = 8Case 6objLayout.StandardScale = ac1_10 txtNumerator = 1 txtDenominator = 10Case 7objLayout.StandardScale = ac1_16 txtNumerator = 1 txtDenominator = 16Case 8objLayout.StandardScale = ac1_20 txtNumerator = 1 txtDenominator = 20Case 9objLayout.StandardScale = ac1_30 txtNumerator = 1 txtDenominator = 30Case 10objLayout.StandardScale = ac1_40 txtNumerator = 1 txtDenominator = 40Case 11objLayout.StandardScale = ac1_50 txtNumerator = 1 txtDenominator = 50Case 12objLayout.StandardScale = ac1_100 txtNumerator = 1 txtDenominator = 100Case 13objLayout.StandardScale = ac2_1 txtNumerator = 2txtDenominator = 1Case 14objLayout.StandardScale = ac4_1txtNumerator = 4txtDenominator = 1Case 15objLayout.StandardScale = ac8_1txtNumerator = 8txtDenominator = 1Case 16objLayout.StandardScale = ac10_1txtNumerator = 10txtDenominator = 1Case 17objLayout.StandardScale = ac100_1txtNumerator = 100txtDenominator = 1End SelectEnd SubPrivate Sub cboPlotStyleTableNames_Change()' 设置打印样式表objLayout.StyleSheet = cboPlotStyleT ableNames.TextEnd SubPrivate Sub cboPrintersName_Change()On Error Resume Next' 设置打印机配置（对应AutoCAD中：打印>打印设备>打印机配置>"DWF6 ePlot.pc3"）objLayout.ConfigName = cboPrintersName.Text' 更新显示AutoCAD中当前可用的所有图纸尺寸Call ListPaperSize' 更新显示AutoCAD中当前可用的所有打印样式表Call ListPlotStyleTableNamesEnd SubPrivate Sub chkCenterPlot_Change()Dim PtOffset(0 To 1) As Double' 设置图纸是否居中打印If chkCenterPlot.Value ThenPtOffset(0) = 0PtOffset(1) = 0ElsePtOffset(0) = -5PtOffset(1) = -5End IftxtOffsetX.Value = PtOffset(0)txtOffsetY.Value = PtOffset(1)End SubPrivate Sub chkPlotHidden_Change()'设置是否隐藏图纸空间对象If chkPlotHidden.Value Then'打印时隐藏图纸空间对象objLayout.PlotHidden = TrueElse'打印时不隐藏图纸空间对象objLayout.PlotHidden = FalseEnd IfEnd SubPrivate Sub chkPlotToFile_Change()'设置“打印到文件”组各控件激活状态If chkPlotT oFile.Value ThenlbPlotPath.Enabled = TruecboPlotPath.Enabled = TruecmdBrowse2.Enabled = TrueElselbPlotPath.Enabled = FalsecboPlotPath.Enabled = FalsecmdBrowse2.Enabled = FalseEnd IfEnd SubPrivate Sub chkPlotWithLineweights_Change() '设置是否打印对象线宽If chkPlotWithLineweights.Value Then'打印时使用图形文件中的线宽objLayout.PlotWithLineweights = TrueElse'打印时使用打印样式中的线宽objLayout.PlotWithLineweights = FalseEnd IfEnd SubPrivate Sub chkPlotWithPlotStyles_Change() '设置是否应用打印样式If chkPlotWithPlotStyles.Value Then'打印时在对象中使用打印样式objLayout.PlotWithPlotStyles = True chkPlotWithLineweights.Enabled = False Else'打印时在对象中不使用打印样式objLayout.PlotWithPlotStyles = False chkPlotWithLineweights.Enabled = TrueEnd IfEnd Sub' 设置图纸打印方向Call PaperRotationChangeEnd SubPrivate Sub cmdAdd_Click()'如果列表框中未存在任何元素If lstCurFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCritical Exit SubEnd IfDim strFlies As StringDim i As IntegerDim n As Integern = 0'将上面列表框中选中的对象添加到下面的列表框中For i = 0 To lstCurFiles.ListCount - 1If lstCurFiles.Selected(i) ThenstrFlies = lstCurFiles.List(i)n = n + 1If Not HasItem(lstPlotFiles, strFlies) Then lstPlotFiles.AddItem lstCurFiles.List(i) 'End IfEnd IfNext i'如果列表框中未存在被选择的元素If n = 0 ThenMsgBox "请选择要从列表中添加的元素！", vbCritical Exit SubEnd IfEnd Sub'如果列表框中未存在任何元素If lstCurFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCriticalExit SubEnd IfDim strFlies As StringDim i As Integer'将上面列表框中选中的对象添加到下面的列表框中For i = 0 To lstCurFiles.ListCount - 1strFlies = lstCurFiles.List(i)If Not HasItem(lstPlotFiles, strFlies) Then lstPlotFiles.AddItem lstCurFiles.List(i)End IfNext iEnd SubPrivate Sub cmdBrowse_Click()'在文本框中显示获得的路径txtCurPath.Text = ReturnFolder(0)End SubPrivate Sub cmdBrowse2_Click()Dim strPath As StringstrPath = ReturnFolder(0)'若返回文件夹路径非空If strPath <> "" Then'若组合框中未存在返回文件夹路径，则将其添加到组合框中If HasItem2(strPath) < 0 Then'在组合框中显示获得的路径With cboPlotPath.AddItem strPath, 0'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End With'若组合框中已存在返回文件夹路径，则将返回文件夹路径置为选中ElseWith cboPlotPath'设置默认的显示项目.ListIndex = HasItem2(strPath)End WithEnd IfEnd IfEnd SubPrivate Sub cmdClear_Click()'如果列表框中未存在任何元素If lstPlotFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCriticalExit SubEnd IfDim i As Integer, n As Integer, count As Integer'列表框中元素的数量count = lstPlotFiles.ListCountn = 0'将列表框中选中的对象删除For i = 0 To count - 1If lstPlotFiles.Selected(i) Thenn = n + 1Else'移动列表框中的元素lstPlotFiles.List(i - n) = lstPlotFiles.List(i)End IfNext i'如果列表框中未存在被选择的元素If n = 0 ThenMsgBox "请选择要从列表中清除的元素！", vbCritical Exit SubEnd If'删除最后n行的元素For i = 1 To nlstPlotFiles.RemoveItem (count - i)Next iEnd SubPrivate Sub cmdClearAll_Click()'如果列表框中未存在任何元素If lstPlotFiles.ListCount = 0 ThenMsgBox "请先向列表框中添加文件！", vbCriticalExit SubEnd IfDim Msg, Style, Title, Help, Ctxt, Response, MyStringMsg = "清除整个图形列表?"Style = vbOKCancel + vbQuestion + vbDefaultButton2 Title = "Clear Files"Response = MsgBox(Msg, Style, Title)If Response = vbOK ThentxtCurPath.Text = ""'清除列表框中所有元素lstPlotFiles.ClearEnd IfEnd SubPrivate Sub cmdExit_Click()'退出EndEnd SubPrivate Sub cmdInput_Click()'导入打印设置'设置标准对话框With comDlg'设置标准对话框标题.DialogTitle = "导入打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"'设置标准对话框的起始目录'.InDir = "C:\"'显示[打开]对话框.ShowOpenEnd WithDim strFileName As StringstrFileName = comDlg.fileName'strFileName = "F:\AutoCAD\丹通施工图\打印设置.txt" '若返回文件名为空，不进行操作If strFileName = "" ThenMsgBox "请重新选择文件位置！"Exit SubEnd If'读入文件的操作Dim i As Integer, nFile As IntegerDim x As Double, y As DoubleDim count As Integer, index As IntegerDim strTemp As String'获得下一个可供Open语句使用的文件号nFile = FreeFile'打开文件Open strFileName For Input As #nFile'读入当前路径'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入当前路径并设置文本框文字Input #nFile, strTemptxtCurPath.Text = strTemp'读入打印文件列表并添加到列表框中Call InputData3(lstPlotFiles, nFile)'读入打印机配置列表并添加到组合框中Call InputData(cboPrintersName, nFile)'读入打印样式表并添加到组合框中Call InputData(cboPlotStyleTableNames, nFile)'读入图纸尺寸列表并添加到组合框中Call InputData(cboPaperSize, nFile)'读入图纸单位并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图纸单位Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "毫米" Then optMillimeters.Value = TrueElseoptInches.Value = TrueEnd If'读入图纸方向并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图纸方向Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "纵向" ThenoptVertical.Value = TrueElseoptHorizontal.Value = TrueEnd If'读入是否反向打印并设置复选按钮选择状态Call InputData2(chkReverse, nFile)'读入打印份数'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入打印份数Input #nFile, count'设置文本框文字txtNumber.Text = count'读入是否打印到文件并设置复选按钮选择状态Call InputData2(chkPlotToFile, nFile)'读入打印路径列表并添加到组合框中Call InputData(cboPlotPath, nFile)'读入打印比例列表并添加到组合框中Call InputData(cboPlotScale, nFile)'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入当前打印比例并设置文本框文字Input #nFile, xInput #nFile, ytxtNumerator.Text = xtxtDenominator.Text = y'读入是否居中打印并设置复选按钮选择状态Call InputData2(chkCenterPlot, nFile)'读入打印偏移'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入打印偏移并设置文本框文字Input #nFile, xInput #nFile, ytxtOffsetX.Text = xtxtOffsetY.Text = y'读入是否打印对象线宽并设置复选按钮选择状态Call InputData2(chkPlotWithLineweights, nFile) '读入是否采用打印样式并设置复选按钮选择状态Call InputData2(chkPlotWithPlotStyles, nFile)'读入是否隐藏图纸空间对象并设置复选按钮选择状态Call InputData2(chkPlotHidden, nFile)'读入图框形式并设置单选按钮选择状态'读入一行文本并存储在变量中Line Input #nFile, strTemp'读入图框形式Input #nFile, strTemp'设置单选按钮选择状态If strTemp = "图块" ThenoptBlock.Value = TrueElseoptLayer.Value = TrueEnd If'读入图块名列表并添加到组合框中Call InputData(cboBlockName, nFile)'读入图层名列表并添加到组合框中Call InputData(cboLayerName, nFile)'关闭文件Close #nFileEnd SubPrivate Sub cmdListPrints_Click()' 显示AutoCAD中当前可用的打印机列表Call ListPrintersEnd SubPrivate Sub cmdOutput_Click()'导出打印设置'设置标准对话框With comDlg'设置标准对话框标题.DialogTitle = "导出打印设置"'设置标准对话框类型列表中所显示的过滤器.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*" '设置标准对话框的起始目录'.InDir = "C:\"'设置[另存为]对话框的缺省扩展名.DefaultExt = "txt"'显示[另存为]对话框.ShowSaveEnd WithDim strFileName As String, strTemp As String strFileName = comDlg.fileName'strFileName = "F:\AutoCAD\丹通施工图\打印设置.txt" '若返回文件名为空，不进行操作If strFileName = "" ThenMsgBox "请重新选择保存位置！"Exit SubEnd If'保存文件的操作Dim i As Integer'打开文件Open strFileName For Output As #1'输出当前路径Print #1, "当前路径："Print #1, txtCurPath.Text'输出打印文件列表Print #1, "打印文件列表："'输出打印机配置列表的信息Call OutputData3(lstPlotFiles, 1)'输出打印机配置Print #1, "打印机配置："'输出打印机配置列表的信息Call OutputData(cboPrintersName, 1)Print #1, "打印样式表："'输出打印样式表的信息Call OutputData(cboPlotStyleTableNames, 1)'输出图纸尺寸列表Print #1, "图纸尺寸列表："'输出图纸尺寸列表的信息Call OutputData(cboPaperSize, 1)'输出图纸单位Print #1, "图纸单位："'输出图纸单位信息If optMillimeters.Value = True Then strTemp = "毫米"ElsestrTemp = "英寸"End IfPrint #1, strTemp'输出图纸方向Print #1, "图纸方向："'输出图纸方向信息If optVertical.Value = True ThenstrTemp = "纵向"ElsestrTemp = "横向"End IfPrint #1, strTempPrint #1, "是否反向打印："Call OutputData2(chkReverse, 1)'输出打印份数Print #1, "打印份数："Print #1, txtNumber.Text'输出是否打印到文件Print #1, "是否打印到文件："Call OutputData2(chkPlotToFile, 1)'输出打印路径Print #1, "打印路径："'输出打印路径列表的信息Call OutputData(cboPlotPath, 1)'输出打印比例Print #1, "打印比例："'输出打印比例列表的信息Call OutputData(cboPlotScale, 1)'输出当前打印比例Print #1, "当前打印比例："Print #1, txtNumerator.TextPrint #1, txtDenominator.Text'输出是否居中打印Print #1, "是否居中打印："Call OutputData2(chkCenterPlot, 1)'输出打印偏移Print #1, "打印偏移："Print #1, txtOffsetX.TextPrint #1, txtOffsetY.Text'输出是否打印对象线宽Print #1, "是否打印对象线宽："Call OutputData2(chkPlotWithLineweights, 1) '输出是否采用打印样式Print #1, "是否采用打印样式："Call OutputData2(chkPlotWithPlotStyles, 1) '输出是否隐藏图纸空间对象Print #1, "是否隐藏图纸空间对象："Call OutputData2(chkPlotHidden, 1)'输出图框形式Print #1, "图框形式："'输出图框形式信息If optBlock.Value = True ThenstrTemp = "图块"ElsestrTemp = "图层"End IfPrint #1, strTemp'输出图块名列表Print #1, "图块名列表："'输出图块名列表的信息Call OutputData(cboBlockName, 1)'输出图层名列表Print #1, "图块名列表："'输出图层名列表的信息Call OutputData(cboLayerName, 1)'关闭文件Close 1End SubPrivate Sub cmdPick_Click()On Error Resume NextDim objSelect As AcadEntityDim ptPick As VariantDim strTemp As StringSet objDoc = ThisDrawing.Application.ActiveDocument'将控制权交给AutoCADfrmBatchPlot.Hide'在AutoCAD中选择实体并判断类型Retry:objDoc.Utility.GetEntity objSelect, ptPick, vbCrLf & "请选择实体："' 处理按下Esc键的错误If objSelect Is Nothing ThenIf CheckKey(VK_ESCAPE) = True Then'显示对话框frmBatchPlot.ShowExit SubElseGoTo RetryEnd IfEnd If' 处理未选择到实体的错误If Err <> 0 ThenErr.ClearGoTo RetryEnd If'若为指定图块If optBlock.Value = True Then'判断实体是否块参照If TypeOf objSelect Is AcadBlockReference Then'判断实体是否模型空间、图纸空间和匿名块If StrComp(Left(, 1), "*") <> 0 Then'获得块参照名strTemp = ElseMsgBox "您选择的是匿名块，请重新选择块参照！", vbCritical '显示对话框frmBatchPlot.ShowExit SubEnd IfElseMsgBox "您选择的不是块参照，请重新选择块参照！", vbCritical'显示对话框frmBatchPlot.ShowExit SubEnd If'刷新块参照列表Call ListBlock'将所选块参照在组合框中置为当前Call SetSelected(cboBlockName, strTemp)Else'判断实体是否多段线If TypeOf objSelect Is AcadLWPolyline Then'获得多段线所在图层名strTemp = yerElseMsgBox "您选择的不是轻量多段线，请重新选择轻量多段线！", vbCritical'显示对话框frmBatchPlot.ShowExit SubEnd If' 刷新图层列表Call ListLayer'将所选实体所在图层在组合框中置为当前Call SetSelected(cboLayerName, strTemp)End If'显示对话框frmBatchPlot.ShowEnd SubPrivate Sub SetSelected(ListObject As Object, SItem As String) '将该元素在组合框中置为当前Dim i As Long'通过比较确定该元素的位置For i = 0 To (ListObject.ListCount - 1)If StrComp(ListObject.List(i), SItem, vbTextCompare) = 0 ThenListObject.ListIndex = iExit SubEnd IfNextEnd SubPrivate Sub cmdPreview_Click()'若按图块进行批量打印If optBlock.Value = True ThenIf cboBlockName.ListCount = 0 Or cboBlockName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall PreviewByBlock(cboBlockName.T ext)'若按图层进行批量打印ElseIf cboLayerName.ListCount = 0 Or cboLayerName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall PreviewByLayer(cboLayerName.T ext)End IfEnd SubPrivate Sub cmdRefresh_Click()'刷新块参照列表Call ListBlock' 刷新图层列表Call ListLayerEnd SubPrivate Sub cmdPlot_Click()'若按图块进行批量打印If optBlock.Value = True ThenIf cboBlockName.ListCount = 0 Or cboBlockName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall BatchPlotByBlock(cboBlockName.Text)'若按图层进行批量打印ElseIf cboLayerName.ListCount = 0 Or cboLayerName.Text = "" ThenMsgBox "请先选择块参照！", vbCriticalExit SubEnd IfCall BatchPlotByLayer(cboLayerName.Text)End IfEnd SubPrivate Sub cmdAbout_Click()'显示关于对话框frmAbout.ShowEnd SubPrivate Sub optBlock_Change()'设置“图块与图层”组各控件激活状态If optBlock.Value = True ThenlbBlockName.Enabled = TruecboBlockName.Enabled = TruelbLayerName.Enabled = False cboLayerName.Enabled = False ElselbBlockName.Enabled = False cboBlockName.Enabled = False lbLayerName.Enabled = True cboLayerName.Enabled = TrueEnd IfEnd SubPrivate Sub optLayer_Change()'设置“图块与图层”组各控件激活状态If optBlock.Value = True Then lbBlockName.Enabled = True cboBlockName.Enabled = True lbLayerName.Enabled = False cboLayerName.Enabled = False ElselbBlockName.Enabled = False cboBlockName.Enabled = False lbLayerName.Enabled = True cboLayerName.Enabled = TrueEnd IfEnd SubPrivate Sub optMillimeters_Change() ' 设置图纸单位If optMillimeters.Value = True Then objLayout.PaperUnits = acMillimeters lbUnit.Caption = "毫米＝" lbUnitX.Caption = "毫米" lbUnitY.Caption = "毫米"lbPaperUnit.Caption = "毫米"ElseobjLayout.PaperUnits = acInches lbUnit.Caption = "英寸＝"lbUnitX.Caption = "英寸"lbUnitY.Caption = "英寸" lbPaperUnit.Caption = "英寸"End If' 显示图纸尺寸Call SetPlotZoneEnd SubPrivate Sub OptVertical_Change()' 设置图纸打印方向Call PaperRotationChangeEnd SubPrivate Sub spnAngle_SpinDown()If CInt(txtNumber.T ext) > 1 Then txtNumber.Text = CInt(txtNumber.Text) - 1 End IfEnd SubPrivate Sub spnAngle_SpinUp() txtNumber.Text = CInt(txtNumber.Text) + 1 End SubPrivate Sub txtCurPath_Change()'查找文件，向列表框中添加If Len(Dir(txtCurPath.Text)) > 0 Then FindFile colDwgs, txtCurPath.Text, "dwg" If AddToList(lstCurFiles, colDwgs) Then End IfEnd IfEnd SubPrivate Sub txtDenominator_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If IsNumeric(txtDenominator) Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex = 0ElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub txtNumber_Change()' 设置图纸打印份数'objPlot.NumberOfCopies = CDbl(txtNumber.Text)'objPlot.NumberOfCopies = CInt(txtNumber.Text)objPlot.NumberOfCopies = txtNumber.ValueEnd SubPrivate Sub txtNumerator_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If IsNumeric(txtNumerator) Then'设置组合框显示项目为“自定义”cboPlotScale.ListIndex = 0ElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub txtOffsetX_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then'取消“居中打印”复选框chkCenterPlot.Value = FalseElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub txtOffsetY_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)' 设置自定义图纸尺寸If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = Asc(".") Or KeyAscii = Asc("-") Then'取消“居中打印”复选框chkCenterPlot.Value = FalseElseMsgBox "请输入数字！", vbCriticalEnd IfEnd SubPrivate Sub UserForm_Initialize()Set objDoc = ThisDrawing.Application.ActiveDocumentSet objLayout = ThisDrawing.ActiveLayoutSet objPlot = ThisDrawing.Plot'禁用“当前路径”文本框txtCurPath.Enabled = False'列出当前所有打印机Call ListPrinters' 显示AutoCAD中当前可用的打印比例列表Call ListPlotScale'设置“打印到文件”是否选中chkPlotToFile.Value = False'禁用“打印到文件”组各控件lbPlotPath.Enabled = FalsecboPlotPath.Enabled = FalsecmdBrowse2.Enabled = False' 显示AutoCAD中当前可用的图块Call ListBlock' 显示AutoCAD中当前可用的图层Call ListLayerEnd SubPublic Function ReturnFolder(lngHwnd As Long) As String Dim Browser As BrowseInfoDim lngFolder As LongDim strPath As StringDim strTemp As StringWith Browser.hOwner = lngHwnd.lpszTitle = "选择工作路径".pszDisplayName = String(MAX_PATH, 0)End With'用空格填充字符串strPath = String(MAX_PATH, 0)'调用API函数显示文件夹列表lngFolder = SHBrowseForFolder(Browser)'使用API函数获取返回的路径If lngFolder ThenSHGetPathFromIDList lngFolder, strPathstrTemp = Left(strPath, InStr(strPath, vbNullChar) - 1)If (Right(strTemp, 1) <> "\") ThenstrTemp = strTemp & "\"End IfReturnFolder = strTempEnd IfEnd FunctionPublic Sub FindFile(ByRef files As Collection, strDir, strExt) '删除集合中所有的对象Dim i As IntegerFor i = 1 To files.countfiles.Remove 1Next i'查找dwg文件，并将其添加到集合中Dim strFileName As StringIf (Right(strDir, 1) <> "\") ThenstrDir = strDir & "\"End IfstrFileName = Dir(strDir & "*.*", vbDirectory)Do While (strFileName <> "")If (UCase(Right(strFileName, 3)) = UCase(strExt)) Thenfiles.Add strDir & strFileNameEnd IfstrFileName = Dir '返回下一个符合条件的文件LoopEnd SubPublic Function AddToList(objBox As ListBox, Names As Collection) As BooleanDim i As IntegerOn Error GoTo Error_ControlobjBox.Clear'将集合中的对象添加到列表框中For i = 1 To Names.countobjBox.AddItem Names(i)Next iExit_Here:AddToList = TrueExit FunctionError_Control:MsgBox "发生下面的错误：" & Err.NumberAddToList = FalseEnd FunctionPrivate Function HasItem(objBox As ListBox, strFlies As String) As Boolean'检查路径是否已经存在HasItem = FalseDim i As IntegerIf objBox.ListCount > 0 ThenFor i = 0 To objBox.ListCount - 1If StrComp(objBox.List(i), strFlies, vbT extCompare) = 0 Then HasItem = TrueExit FunctionEnd IfNext iEnd IfEnd FunctionPrivate Function HasItem2(ByVal strPath As String) As Integer'检查路径是否已经存在HasItem2 = -1Dim i As IntegerIf cboPlotPath.ListCount > 0 ThenFor i = 0 To cboPlotPath.ListCount - 1If StrComp(cboPlotPath.List(i), strPath, vbTextCompare) = 0 ThenHasItem2 = iExit FunctionEnd IfNext iEnd IfEnd Function'打开或激活文件Private Sub OpenFile(fileName As String)Dim dwgFile As AcadDocumentDim strFile As StringFor Each dwgFile In ThisDrawing.Application.Documents strFile = dwgFile.Path & "\" & '若第i个图形文件已经被打开，则将其激活If strFile = fileName Then'若dwgFile尚未激活，则将其激活If dwgFile.Active = False ThenThisDrawing.Application.ActiveDocument = dwgFile End IfExit SubEnd IfNext'若第i个图形文件尚未被打开，则将其打开ThisDrawing.Application.Documents.Open fileNameEnd Sub' 显示AutoCAD中当前可用的打印机列表Public Sub ListPrinters()objLayout.RefreshPlotDeviceInfo' 获得所有的可用打印机Dim plotDevices As VariantplotDevices = objLayout.GetPlotDeviceNames' 删除以前的打印机列表cboPrintersName.Clear' 显示打印机列表Dim i As IntegerFor i = 0 To UBound(plotDevices) cboPrintersName.AddItem (plotDevices(i))Next i' 设置组合框初始选项With cboPrintersName'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 1End WithEnd Sub' 显示AutoCAD中当前可用的打印样式Public Sub ListPlotStyleTableNames()Set objLayout = ThisDrawing.ActiveLayout objLayout.RefreshPlotDeviceInfo' 获得所有的可用打印样式Dim plotStyleTables As VariantplotStyleTables = objLayout.GetPlotStyleTableNames' 删除以前的打印样式列表cboPlotStyleTableNames.Clear' 显打印样式列表Dim i As IntegerFor i = 0 To UBound(plotStyleTables) cboPlotStyleTableNames.AddItem (plotStyleTables(i)) Next i' 设置组合框初始选项With cboPlotStyleT ableNames'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End WithEnd Sub' 显示AutoCAD中当前可用的图纸尺寸Public Sub ListPaperSize()objLayout.RefreshPlotDeviceInfo' 获得所有当前可用可用图纸尺寸列表Dim paperSizes As VariantpaperSizes = objLayout.GetCanonicalMediaNames' 删除以前的图纸尺寸列表cboPaperSize.Clear' 显示图纸尺寸列表Dim i As IntegerFor i = 0 To UBound(paperSizes) cboPaperSize.AddItem (paperSizes(i))Next i' 设置组合框初始选项With cboPaperSize'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 0End WithEnd Sub' 显示AutoCAD中可以使用的打印比例Public Sub ListPlotScale()' 显打印比例列表With cboPlotScale.AddItem ("自定义"), 0.AddItem ("按图纸空间缩放"), 1.AddItem ("1:1"), 2.AddItem ("1:2"), 3.AddItem ("1:4"), 4.AddItem ("1:8"), 5.AddItem ("1:10"), 6.AddItem ("1:16"), 7.AddItem ("1:20"), 8.AddItem ("1:30"), 9.AddItem ("1:40"), 10.AddItem ("1:50"), 11.AddItem ("1:100"), 12.AddItem ("2:1"), 13.AddItem ("4:1"), 14.AddItem ("8:1"), 15.AddItem ("10:1"), 16.AddItem ("100:1"), 17'使用下拉列表的形式.Style = fmStyleDropDownList'设置下拉列表的下标下限.BoundColumn = 0'设置默认的显示项目.ListIndex = 2End WithtxtNumerator = 1txtDenominator = 1End Sub' 显示AutoCAD中当前可用的图层Public Sub ListLayer()Dim LayerList As Collection'获得图形中存在的图层列表Set LayerList = GetLayerList()'刷新图层列表Call RefreshList(cboLayerName, LayerList)'选择图层列表中的第一个实体If cboLayerName.ListIndex = -1 Then cboLayerName.ListIndex = 0End IfEnd Sub'获得图形中存在的图层列表Private Function GetLayerList() As Collection Dim objLayer As AcadLayerDim LayerList As New CollectionSet objDoc = ThisDrawing.Application.ActiveDocument '获得可用的图层For Each objLayer In yersLayerList.Add , Next'返回图形中块参照的列表Set GetLayerList = LayerListEnd Function' 显示AutoCAD中当前可用的图块Public Sub ListBlock()Dim BlockReferenceList As Collection'获得图形中存在的块参照列表Set BlockReferenceList = GetBlockReferences()'判断是否存在块参照If BlockReferenceList Is Nothing ThenMsgBox "当前图形中不存在任何的块！", vbExclamation Exit SubEnd If'刷新块参照列表Call RefreshList(cboBlockName, BlockReferenceList)'选择块参照列表中的第一个实体If cboBlockName.ListIndex = -1 Then cboBlockName.ListIndex = 0End If。