vb报表分组
VB多个sheet按某一条件拆分成单个表格拆分后的单个文件包含多个sheet
多个sheet按某一条件拆分成单个表格（拆分后的单个文件包含多个sheet）注:标颜色的是需要根据实际数据更改部分Private Sub CommandButton1_Click（）Dim t As Singlet = Timer'通过专员（四季度）表获取所有大区信息Worksheets（"专员（四季度）"）.Select’输入获取拆分需要的条件列Dim col_namecol_name = "D"’输入拆分的开始行，要求输入的是数字Dim start_row As Integerstart_row = 5'暂停屏幕更新Application.ScreenUpdating = False’工作表的总行数Dim end_rowend_row = Worksheets("专员(四季度)").Range("A65536").End(xlUp).Row'将大区信息保存入数组'对于二维数组，ReDim只能扩充最后一维，因此sheet_m叩行不变，扩充列Dim sheet_map(), sheet_indexReDim sheet_map(1, 0)sheet_map(0, 0) = Worksheets。
'专员(四季度)").Range(col_name &start_row).Valuesheet_map(1, 0) = 1sheet_index = 0With Worksheets("专员(四季度)。
Dim have, temp, iFor i = start_row + 1 To end_rowtemp = Worksheets("专员(四季度)").Range(col_name & i).Value have = 0For j = 0 To sheet_indexIf temp = sheet_map(0, j) Thenhave = 1End IfIf have = 0 ThenReDim Preserve sheet_map(1, sheet_index + 1)sheet_index = sheet_index + 1sheet_map(0, sheet_index) = tempEnd IfNextEnd With’根据前面计算的拆分表，拆分成单个文件Dim row_indexrow_index = start_rowFor i = 0 To sheet_indexWorkbooks.Add’创建最终数据文件夹Dim dir_namedir_name = ThisWorkbook.Path & "\按大区拆分出的表格\"If Dir(dir_name, vbDirectory) = "" ThenMkDir (dir_name)End If'创建新工作簿Dim workbook_pathworkbook_path = ThisWorkbook.Path & "\按大区拆分出的表格\" & sheet_map(0, i) & ".xlsx"ActiveWorkbook.SaveAs workbook_pathFor k = Workbooks(sheet_map(0, i) & ".xlsx").Sheets.Count To 3 Step -1 Workbooks(sheet_map(0, i) & ".xlsx").Sheets(k).DeleteNext'最后一个sheet前加单引号防止创建空表此句可删掉Sheets.Add after:=Workbooks(sheet_map(0, i) & ".xlsx").Sheets(1)Sheets.Add after:=Workbooks(sheet_map(0, i) & ".xlsx").Sheets(2)Sheets.Add after:二Workbooks(sheet_map(0, i) & ".xlsx").Sheets(3)Sheets.Add after:二Workbooks(sheet_map(0, i) & ".xlsx").Sheets(4)Sheets.Add after:=Workbooks(sheet_map(0, i) & ".xlsx").Sheets(5)' Sheets.Add after:=Workbooks(sheet_map(0, i) & ".xlsx").Sheets(6)Workbooks(sheet_map(0, i) & ".xlsx").Sheets(1).Name ="专员(四季度)Workbooks(sheet_map(0, i) & ".xlsx").Sheets(2).Name ="经理(四季度)Workbooks(sheet_map(0, i) & ".xlsx").Sheets(3).Name = 2绩效得分-专员"Workbooks(sheet_map(0, i) & ".xlsx").Sheets(4).Name = 2绩效得分-经理"Workbooks(sheet_map(0, i) & ".xlsx").Sheets(5).Name ="超期罚款"Workbooks(sheet_map(0, i) & ".xlsx").Sheets(6).Name ="退货罚款"第一个sheet页拆分'激活当前工作簿，ThisWorkbook表示当前跑代码的工作簿ThisWorkbook.Activateend_row = Worksheets("专员(四季度)").Range("A65536").End(xlUp).Row号拷贝条目数据(即最前面不需要拆分的数据行)Dim row_rangerow_range = 1 & ":" & (5 - 1)Worksheets。
VB6中实现动态统计报表
在利用VB开发MIS系统的过程中,经常需要制作动态统计报表。
本文就如何实现动态数据源下的分组交叉统计报表进行阐述，并结合实例给出编程指导。
在VB6.0的数据环境设计器中,我们可以利用“添加命令”一项来连接报表所需的数据源,同时利用“添加命令”属性中的分组与合计功能设计分组交叉统计报表的数据源,至此我们可以设计简单的数据存在于单一表静态数据源下分组交叉报表,对于数据存在多表的复杂的动态数据源下的分组交叉报表来说,仍实现不了,实现该功能的关键在于构造一个符合动态数据源要求的中间表。
下面以一管理系统中工程成本统计报表的实例来说明如何实现动态数据源下的分组交叉统计报表。
一、报表要求与分析该报表要求列出在指定的时间段内实施的各项工程所耗器材明细、数量、费用，并且计算各项工程的成本，最终计算所有工程的累计成本。
需求分析后可知该报表是个典型的动态数据源下分组统计报表，分组项为工程名称，要求对每个分组进行子汇总和对所有分组进行总汇总。
由于在该系统中的出库单和出库单明细分别存放在不同的表中，因此必须根据报表的要求预先构造一个成本统计中间表，命名为EquipMentCost。
相关表结构如图1。
通过对表OutBill和OutBillDetail的分析,发现两者通过关键字OutBill 相联,下面通过SQL语句生成中间表EquipmentCost,语句如下:Insert into EquipmentCost(Project,Name,Standard,Type,Num,Cost)select a.project as 'Project', as 'Name',b.standard as 'Standard', b.type as 'Type',b.num aswhere a.OutDate>=date1 and a.OutDate<=date2date1 和date2 变量用来指定时间，注意插入前要先清空该中间表的所有数据。
VBA实现Excel的数据分组与聚合
VBA实现Excel的数据分组与聚合在日常的工作中，Excel是一个常用的办公软件。
尤其是在处理大量数据时，Excel的强大功能可以帮助我们更高效地处理数据。
VBA（Visual Basic for Applications）是Excel的一个宏语言，它可以帮助我们实现自动化、批量化处理数据的任务。
在本文中，我们将着重探讨如何使用VBA实现Excel 的数据分组与聚合功能。
数据分组是将一组数据按照特定条件进行分类，并在分类的基础上进行统计和分析的过程。
这对于处理大量数据时的整理和分析非常有用。
Excel 提供了数据分组的功能，但是在处理大数据量时，手动进行分组工作量很大且容易出错。
而使用VBA语言可以自动化处理这个过程，提高工作效率。
首先，我们需要创建一个VBA宏，下面是步骤：1. 打开Excel，按下"Alt+F11"，打开VBA编辑器。
2. 在VBA编辑器中，选择"插入" -> "模块"，创建一个新的模块。
3. 在新建的模块中，编写VBA代码。
在进行数据分组之前，我们需要明确数据分组的条件和目标。
假设我们有一个包含不同产品销售数据的Excel表格，包括产品名称、销售数量和销售金额。
我们想要按照产品的名称对数据进行分组，并计算每个产品的总销售数量和总销售金额。
下面是一个示例的VBA代码，实现了这个功能：```vbaSub GroupAndAggregateData()' 定义变量Dim rng As RangeDim cell As RangeDim dict As ObjectDim product As StringDim totalQuantity As DoubleDim totalAmount As Double' 设置工作表和数据范围Set ws = ThisWorkbook.Sheets("Sheet1")Set rng = ws.Range("A2:C100") ' 数据范围' 初始化字典Set dict = CreateObject("Scripting.Dictionary") ' 循环遍历数据For Each cell In rng' 获取产品名称product = cell.Value' 判断产品名称是否已存在于字典中If dict.Exists(product) Then' 如果存在，累加销售数量和销售金额totalQuantity = dict.Item(product)("Quantity") + cell.Offset(0,1).ValuetotalAmount = dict.Item(product)("Amount") + cell.Offset(0, 2).Value ' 更新字典中的值dict.Item(product)("Quantity") = totalQuantitydict.Item(product)("Amount") = totalAmountElse' 如果不存在，添加新的产品到字典中Set dict(product) = CreateObject("Scripting.Dictionary")dict.Item(product)("Quantity") = cell.Offset(0, 1).Valuedict.Item(product)("Amount") = cell.Offset(0, 2).ValueEnd IfNext cell' 将结果输出到新的工作表Set wsResult = ThisWorkbook.Sheets.Add = "Result"wsResult.Cells(1, 1).Value = "产品名称"wsResult.Cells(1, 2).Value = "总销售数量"wsResult.Cells(1, 3).Value = "总销售金额"' 循环遍历字典，并将结果写入工作表For i = 1 To dict.CountwsResult.Cells(i + 1, 1).Value = dict.Keys(i - 1)wsResult.Cells(i + 1, 2).Value = dict.Items(i - 1)("Quantity")wsResult.Cells(i + 1, 3).Value = dict.Items(i - 1)("Amount")Next iEnd Sub```以上的VBA代码实现了将Excel表格中的数据按照产品名称进行分组，并计算每个产品的总销售数量和总销售金额。
VBA中的数据透视表分组与汇总技巧
VBA中的数据透视表分组与汇总技巧数据透视表是Excel中常用的功能，它可以帮助我们对大量数据进行快速的分析和汇总。
在VBA中，我们可以利用一些技巧来进一步操作数据透视表，使其更加灵活和高效。
本文将介绍一些VBA中的数据透视表分组与汇总技巧，以帮助读者更好地应用这一功能。
首先，我们来了解一下数据透视表中的分组技巧。
在数据透视表中，我们可以根据不同的字段对数据进行分组，以便更好地展示和汇总数据。
在VBA中，可以通过以下代码实现对数据透视表的字段进行分组：```vbaActiveSheet.PivotTables("PivotTable1").PivotFields("字段名").Orientation = xlDataField```其中，"PivotTable1"是数据透视表的名称，"字段名"是要进行分组的字段名称。
通过以上代码，我们可以将指定的字段移动到数据区域，实现分组效果。
除了对字段进行分组，我们还可以通过VBA来设置数据透视表中的汇总方式。
数据透视表中常用的汇总方式有总和、平均值、计数等。
我们可以通过以下代码来设置汇总方式：```vbaActiveSheet.PivotTables("PivotTable1").PivotFields("字段名").Function = xlSum```上述代码中的"字段名"表示要设置汇总方式的字段名称，"xlSum"表示要设置的汇总方式，此处为求和。
我们可以根据实际需要将"xlSum"改为其他值，如"xlAverage"（平均值）或"xlCount"（计数），以实现不同的汇总方式。
在数据透视表中，还经常会有对数据进行过滤的需求。
VBA提供了多种方法来实现数据透视表的筛选和过滤。
VBA中的数据分组和数据透视表技巧
VBA中的数据分组和数据透视表技巧VBA（Visual Basic for Applications）是一种广泛应用于Microsoft Office套件中的编程语言，它可以帮助用户自动化和定制化各种操作。
在Excel中，VBA可以被用来进行数据处理和分析，极大地提高工作效率。
其中，数据分组和数据透视表是Excel中常用的功能，本文将介绍如何使用VBA在Excel中实现数据分组和数据透视表的技巧。
首先，让我们来看一下数据分组的技巧。
数据分组是指将数据按照一定的规则进行分类汇总，以便更好地进行数据分析。
在VBA中，我们可以使用Group方法实现数据分组。
具体操作如下：首先，打开Excel并选择要进行数据分组的数据范围。
然后，按下ALT+ F11打开Visual Basic Editor。
在Visual Basic Editor中，点击插入菜单，选择模块，打开一个新的模块。
在新的模块中，编写以下VBA代码：```Sub GroupData()Dim rng As RangeDim ws As WorksheetSet ws = ThisWorkbook.Worksheets("Sheet1") '将"Sheet1"替换为你要操作的工作表名称Set rng = ws.Range("A1:B10") '将"A1:B10"替换为你要进行数据分组的数据范围rng.Rows.Group '将行数据进行分组rng.Columns.Group '将列数据进行分组End Sub```然后，点击运行按钮或按下F5执行代码。
你将看到选定的数据范围被分成了几个可展开和折叠的组。
这使得你可以更方便地查看和分析数据。
接下来，让我们了解数据透视表的技巧。
数据透视表是一种灵活的数据分析工具，可以帮助用户快速汇总和统计大量数据。
VB利用DataReport做报表详解
VB利用DataReport做报表首先介绍一下DataReport对象的几个常用属性。
一是DataSource，用于设置一个数据源，通过该数据源，数据使用者被绑定到一个数据库；二是DataMember，从DataSource提供的几个数据成员中设置一个特定的数据成员；三是LeftMargin、RightMargin、TopMargin、BottomMargin等，用于指定报表的左右上下的页边距；四是Sections，即DataReport的报表标头、页标头、细节、页脚注、报表脚注5个区域，如果加上分组(可以有多层分组)，则增加一对区域，即分组标头、分组脚注。
其中DataSource一般是一个数据环境或是ADODB.Connection类型的变量，而DataMember则对应数据环境中的Command或是ADODB.RecordSet类型的变量，推荐使用数据环境及Command，页边界大家肯定都很清楚，下面我主要介绍以下Sections，这也是DataReport的精髓所在。
Sections是一个集合，您可以为每一个Section指定名称，也可以用其缺省的索引，从上到下依次为1、2…。
每个Section均有Height和Visible属性，您可以在一定条件下使一个Section不可见。
在Section中可以放置各种报表控件，其中RptLabel、RptImage、RptShape 和RptLine可以放在任意的Section中，用于输出各种文字、图形及表格线；RptTextBox只能放在细节中，一般用于绑定输出DataMemeber提供的数据字段；RptFunction只能被放置在分组注脚中,用于输出使用各种内置函数计算出的合计、最大值、最小值、平均值、记数等等。
上述报表控件中常用公共属性有用于控制位置及高度宽度的Top、Left、Height、Width和控制可见性的Visible；其中RptTextBox还有DataField、DataMember、DataFormat及Font属性；其他属性不再多说。
vb报表分组
在VB中使用动态分组报表在使用VB自带的报表过程中，我遇到了处理动态分组报表的问题。
一般要使用分组报表要在VB中建立一个DataEnvironment，并在其中建立数据库联接和命令对象，在命令对象中设置分组字段，最后将这些分组字段加入到报表中。
但是这种方法只能适应静态的数据源，当遇到数据表中的字段不固定，或数据表不能预先知道的情况时，这种方法就无能为力了。
经过查阅各种资料，发现我们可以通过使用Data Shaping来动态创建分组信息。
下面就详细介绍一下如何动态创建分组信息，并应用于VB报表。
要使用Data Shaping，程序必须使用ActiveX Data Object (ADO)连接数据库，解决问题的关键是使用Data Shaping的驱动程序代替通常使用的各种OLE DB的驱动程序，它的用法跟使用其它驱动程序类似，对于已有的数据访问代码不用作任何修改，只是简单的修改一下连接代码就可以支持Data Shaping了。
具体做法如下：将连接参数中的Provider设置成"MSDataShape" 即ConnectionString = "Provider=MSDataShape;Data Provider=通常的驱动程序;Data Source=…;其它的参数"然后就可以和平常一样进行数据连接和各种数据操作了。
如此连接的数据源出了具有用普通方法的所有特性以外，同时具有了我们即将使用的Data Shaping功能，下面就可以建立自己的分组信息了：将用于打开记录集的SQL语句写成如下形式：SHAPE {select 字段1, 字段2, 字段3,…, 字段n from 现有的表} AS 新的名称1COMPUTE新的名称1 AS新的名称2 BY 分组字段1, 分组字段2,…, 分组字段n上面的语句中，需要注意的是分组字段必须同时在Select 中出现，否则运行时将报错。
VB利用DataReport做报表详解
首先介绍下DataReport对象几个常用属性是DataSource用于设置个数据源通过该数据源数据使用者被绑定到个数据库； 2是DataMember从DataSource提供几个数据成员中设置个特定数据成员；3是LeftMargin、RightMargin、TopMargin、BottomMargin等用于指定报表左右上下页边距； 4是Sections即DataaReport报表标头、页标头、细节、页脚注、报表脚注5个区域如果加上分组(可以有多层分组)则增加对区域即分组标头、分组脚注其中DataSource般是个数据环境或是ADODB.Connection类型变量而DataMember则对应数据环境中Command或是ADODB.RecordSet类型变量推荐使用数据环境及Command页边界大家肯定都很清楚下面我主要介绍以下Sections这也是DataReport精髓所在Sections是个集合您可以为每个Section指定名称也可以用其缺省索引从上到下依次为1、2…每个Section均有Height和Visible属性您可以在定条件下使个Section不可见在Section中可以放置各种报表Control控件其中RptLabel、RptImage、RptShape和RptLine可以放在任意Section中用于输出各种文字、图形及表格线；RptTextBox只能放在细节中般用于绑定输出DataMemeber提供数据字段；RptFunction只能被放置在分组注脚中,用于输出使用各种内置计算出合计、最大值、最小值、平均值、记数等等上述报表Control控件中常用公共属性有用于控制位置及高度宽度Top、Left、Height、Width和控制可见性Visible；其中RptTextBox还有DataField、DataMember、DataFormat及Font属性；其他属性不再多说然后介绍下我使用经验是对想控制报表Control控件按类型有规律命名； 2是用RptShape矩形框做表格线框比用RptLine画框省事多了只有斜线才使用RptLine； 3是报表标题及报表中表头文字、日期及页码用RptLabel其中Caption属性支持转义%D为长格式日期%d为短格式日期%P为总页数%p为当前页码（注意：D和d，P和p大小写的区别）； 4是对固定报表在设计窗口直接将报表Control控件摆放到位对于活报表应首先考虑报表最大情形将足够Control控件分别放置在区别区域位置大小可以不必深究然后在报表输出前用VBA代码对所有Control控件属性进行调整包括位置、高度、宽度、字体、对齐方式、显示格式、可见性等等相应对Section也应根据情况调整其高度和可见性最后用个例子模板来介绍说明其使用思路方法连接数据库With 数据环境.rsCommand名If .State = adStateOpen Then .Close .Source = SQL语句.Open 打开想输出数据库数据项以便输出End WithWith 报表名.DataSource=数据环境.DataMember=Command名这两行也可固定设好而不必每次设置设置页表头部分(RpttLabel…为报表Control控件名).Sections(2).Controls("RptLabelPage").Caption = "共%P页第%p页".Sections(2).Controls("RptLabelDate").Caption = "打印日期:%D".Sections(3).Controls("RptLabel1").Left=……设置细节部分(RptShapeX、RptTextBoxX为报表Control控件名).Sections(3).Controls("RptShape1").Left=….Sections(3).Controls("RptShape1").Top=….Sections(3).Controls("RptShape1").Height=….Sections(3).Controls("RptShape1").Width=….Sections(3).Controls("RptTextBox1").DataMember=Command名.Sections(3).Controls("RptTextBox1").DataField=字段1.Section s(3).Controls("RptTextBox1")=…….Sections(3).Controls("RptShapeN").Visible=False.Sections(3).Controls("RptTextBoxN").Visible=False…. Sections(3).Height=计算出或固定细节高度动态调整报表标题(RptLabelTitle为报表标签Control控件名).Sections(2). Controls("Rpt LabelTitle").Left=…….Sections(2). Controls("RptLabelTitle").Alignment=……调整完毕后.Show 或 .PrReportEnd With这样做优点是报表设计时简单调整方便、随意只需更改点代码而不必为了点点修改而费神在设计窗口调整半天vb6.0 中,用"datareport" 报表控件制作报表,纸张定义 A4 A3 <上一篇 | 下一篇> '在vb6.0中,用"datareport" 报表控件制作报表,当使用报表预览功能时,"datareport"'报表控件将使用"windows系统的当前默认打印机"的打印设置,若该打印设置纸张尺寸(如A4纸)小于"datareport"'报表控件所需纸张尺寸(如A3纸),则"datareport" 报表预览时将会出现"打印纸张尺寸小于报表宽度"错误,'请教如何用代码设置"windows系统的当前默认打印机"的打印机纸张尺寸,而不需用"公共对话框"的打印设置方法?Option ExplicitPublic Enum PrinterOrientationConstantsOrientPortrait = 2OrientLandscape = 1End Enum'Printer.PaperSize = vbPRPSA3Private Type DEVMODEdmDeviceName As String * 32dmSpecVersion As IntegerdmDriverVersion As Integer dmSize As IntegerdmDriverExtra As IntegerdmFields As LongdmOrientation As IntegerdmPaperSize As IntegerdmPaperLength As IntegerdmPaperWidth As IntegerdmScale As IntegerdmCopies As IntegerdmDefaultSource As Integer dmPrintQuality As Integer dmColor As IntegerdmDuplex As IntegerdmYResolution As IntegerdmTTOption As IntegerdmCollate As IntegerdmFormName As String * 32 dmUnusedPadding As Integer dmBitsPerPel As IntegerdmPelsWidth As LongdmPelsHeight As LongdmDisplayFlags As LongdmDisplayFrequency As Long End TypePrivate Type PRINTER_DEFAULTSpDataType As StringpDevMode As LongDesiredAccess As LongEnd TypePrivate Type PRINTER_INFO_2pServerName As LongpPrinterName As LongpShareName As LongpPortName As LongpDriverName As LongpComment As LongpLocation As LongpDevMode As LongpSepFile As LongpPrintProcessor As LongpDataType As LongpParameters As LongpSecurityDescriptor As LongAttributes As LongPriority As LongDefaultPriority As LongStartTime As LongUntilTime As LongStatus As LongcJobs As LongAveragePPM As LongEnd TypePrivate Const DC_PAPERNAMES = 16Private Const DC_PAPERS = 2Private Const DC_PAPERSIZE = 3Private Const DM_IN_BUFFER = 8Private Const DM_OUT_BUFFER = 2Private Const DM_ORIENTATION = &H1Private Const DM_PAPERSIZE = &H2&Private Const DMPAPER_A3 = 8 ' A3 297 x 420 mmPrivate Const DMPAPER_A4 = 9 ' A4 210 x 297 mmPrivate Const PRINTER_ACCESS_ADMINISTER = &H4Private Const PRINTER_ACCESS_USE = &H8Private Const STANDARD_RIGHTS_REQUIRED = &HF0000Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _ PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)Private Declare Function OpenPrinter Lib "winspool.drv" Alias _"OpenPrinterA" (ByVal pPrinterName As String, phPrinter As _ Long, pDefault As Any) As LongPrivate Declare Function ClosePrinter Lib "winspool.drv" _(ByVal hPrinter As Long) As LongPrivate Declare Function DocumentProperties Lib "winspool.drv" _Alias "DocumentPropertiesA" (ByVal hWnd As Long, ByVal hPrinter As Long, _ByVal pDeviceName As String, pDevModeOutput As Any, pDevModeInput As Any, _ByVal fMode As Long) As LongPrivate Declare Function GetPrinter Lib "winspool.drv" _Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As LongPrivate Declare Function SetPrinter Lib "winspool.drv" _Alias "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _pPrinter As Any, ByVal Command As Long) As LongPrivate Declare Function DeviceCapabilities Lib "winspool.drv" _Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, ByVal lpPort As String, _ByVal iIndex As Long, ByVal lpOutput As String, lpDevMode As DEVMODE) As LongFunction SetDefaultPrinterOrientation(ByVal eOrientation As _PrinterOrientationConstants, ByVal strPaperSize As String) As BooleanDim bDevMode() As ByteDim bPrinterInfo2() As ByteDim hPrinter As LongDim lResult As LongDim nSize As LongDim sPrnName As StringDim dm As DEVMODEDim pd As PRINTER_DEFAULTSDim pi2 As PRINTER_INFO_2' Get device name of default printersPrnName = Printer.DeviceName' PRINTER_ALL_ACCESS required under' NT, because we're going to call' SetPrinterpd.DesiredAccess = PRINTER_ALL_ACCESS' Get a handle to the printer.If OpenPrinter(sPrnName, hPrinter, pd) Then' Get number of bytes requires for' PRINTER_INFO_2 structureCall GetPrinter(hPrinter, 2&, 0&, 0&, nSize)' Create a buffer of the required si zeReDim bPrinterInfo2(1 To nSize) As Byte' Fill buffer with structurelResult = GetPrinter(hPrinter, 2, bPrinterInfo2(1), _nSize, nSize)' Copy fixed portion of structure' into VB Type variableCall CopyMemory(pi2, bPrinterInfo2(1), Len(pi2))' Get number of bytes requires for' DEVMODE structurenSize = DocumentProperties(0&, hPrinter, sPrnName, _ 0&, 0&, 0)' Create a buffer of the required si zeReDim bDevMode(1 To nSize)' If PRINTER_INFO_2 points to a DEVMOD E' structure, copy it into our bufferIf pi2.pDevMode ThenCall CopyMemory(bDevMode(1), ByVal pi2.pDevMode, Len(dm))Else' Otherwise, call DocumentProperties ' to get a DEVMODE structureCall DocumentProperties(0&, hPrinter, sPrnName, _bDevMode(1), 0&, DM_OUT_BUFFER)End If' Copy fixed portion of structure' into VB Type variableCall CopyMemory(dm, bDevMode(1), Len(dm))With dm' Set new orientationSelect Case strPaperSizeCase "A3".dmPaperSize = DMPAPER_A3 Case "A4".dmPaperSize = DMPAPER_A4 End Select.dmOrientation = eOrientation.dmFields = DM_ORIENTATION + DM_PAPERSIZE End With' Copy our Type back into bufferCall CopyMemory(bDevMode(1), dm, Len(dm))' Set new orientationCall DocumentProperties(0&, hPrinter, sPrnName, _ bDevMode(1), bDevMode(1), DM_IN_BUFFER Or _ DM_OUT_BUFFER)' Point PRINTER_INFO_2 at our' modified DEVMODEpi2.pDevMode = VarPtr(bDevMode(1))' Set new orientation system-widelResult = SetPrinter(hPrinter, 2, pi2, 0&)' Clean up and exitCall ClosePrinter(hPrinter)SetDefaultPrinterOrientation = TrueElseSetDefaultPrinterOrientation = FalseEnd IfEnd Function''''----------------------------------''''---njx:窗体调用的代码：打印纸选用：1:纵向 2.横向'''SetDefaultPrinterOrientation 2, "A3"''''-----------------------------------1.报表的概念利用报表可以把数据表中的数据按一定的格式输出到屏幕上或打印到纸上。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
在VB中使用动态分组报表
在使用VB自带的报表过程中，我遇到了处理动态分组报表的问题。
一般要使用分组报表要在VB中建立一个DataEnvironment，并在其中建立数据库联接和命令对象，在命令对象中设置分组字段，最后将这些分组字段加入到报表中。
但是这种方法只能适应静态的数据源，当遇到数据表中的字段不固定，或数据表不能预先知道的情况时，这种方法就无能为力了。
经过查阅各种资料，发现我们可以通过使用Data Shaping来动态创建分组信息。
下面就详细介绍一下如何动态创建分组信息，并应用于VB报表。
要使用Data Shaping，程序必须使用ActiveX Data Object (ADO)连接数据库，解决问题的关键是使用Data Shaping的驱动程序代替通常使用的各种OLE DB的驱动程序，它的用法跟使用其它驱动程序类似，对于已有的数据访问代码不用作任何修改，只是简单的修改一下连接代码就可以支持Data Shaping了。
具体做法如下：
将连接参数中的
Provider设置成"MSDataShape" 即
ConnectionString = "Provider=MSDataShape;Data Provider=通常的驱动程序;Data Source=…;其它的参数"
然后就可以和平常一样进行数据连接和各种数据操作了。
如此连接的数据源出了具有用普通方法的所有特性以外，同时具有了我们即将使用的Data Shaping功能，下面就可以建立自己的分组信息了：
将用于打开记录集的SQL语句写成如下形式：
SHAPE {select 字段1, 字段2, 字段3,…, 字段n from 现有的表} AS 新的名称1
COMPUTE新的名称1 AS新的名称2 BY 分组字段1, 分组字段2,…, 分组字段n
上面的语句中，需要注意的是分组字段必须同时在Select 中出现，否则运行时将报错。
用该SQL语句打开的记录集中包含若干个字段，它们是：新的名称2、分组字段1-n。
在使用时，将打开的记录集rs作为报表的DataSource，在报表的分组部分可以直接且只能使用
分组字段1-n以及各种统计函数，在正文中使用字段1-n时，应将对应编辑框的DataMenber 设置为”新的名称2”，具体请参考以下语句
MyReport.Sections("GroupHeader").Controls("Text1").DataField =”分组字段1”
MyReport.Sections("GroupFooter").Controls("Function1").DataMember = "新的名称2"
MyReport.Sections("GroupFooter").Controls("Function1").DataField = "字段1"
MyReport.Sections("PageContent").Controls("Text2").DataMember = "新的名称2"
MyReport.Sections("PageContent").Controls("Text2").DataField =”字段1”
按照以上的方法就可以对带有分组的报表进行动态数据绑定了，这对于那些操作临时表的情况十分有用，因为临时表是无法用设计器设计分组的。
关于Data Shaping的详细介绍可以去参考MSDN在线资源，在一般情况下我们可以用设计器去设计一个类似的结构，然后查看VB设计器生成的代码，这样就可以套用我们自己表了。
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim Sql, strSql As String
'连接数据库(Access)
Set cn = New ADODB.Connection
With cn
.Provider = "MSDataShape.1" '一定要这句
.Open "Data Provider=Microsoft.Jet.OLEDB.4.0 ;" & _
"Data Source=" & App.Path & "\db1.mdb;" & _
"Persist Security Info=False"
End With
'设置RptTextBox控件属性
'分组标头，注意不要设置其DataMember属性
RptGroup.Sections("Section6").Controls("text1").DataField = "编号"
'细节标头,其中“miCmd”是分组名称
RptGroup.Sections("Section1").Controls("text2").DataField = "编号"
RptGroup.Sections("Section1").Controls("text3").DataField = "名字"
RptGroup.Sections("Section1").Controls("text3").DataMember = "miCmd"
'查询表：
Sql = "SELECT * FROM tb "
'打开查询记录集
strSql = "SHAPE {" & Sql & " } " & _
"AS miCmd COMPUTE miCmd BY '编号' "
Set rs = New ADODB.Recordset
rs.Open strSql, cn, adOpenStatic, adLockReadOnly
Set Me.DataSource = rs。