很简单的,步骤如下:
1、新建vb工程,部件里选取arp的那个runtime designer,保存工程;不要更改form1的默认名称;
2、在form1上放3个command button,也不要改默认名字;
、用记事本打开form1.frm,把下面代码粘进去:
VERSION 5.00
Object = "{E281C260-6F27-11D1-8AF0-00A0C98CD92B}#2.0#0"; "ardespro2.dll"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 7065
ClientLeft = 60
ClientTop = 345
ClientWidth = 9180
LinkTopic = "Form1"
ScaleHeight = 7065
ScaleWidth = 9180
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton Command3
Caption = "Close"
Height = 375
Left = 2640
TabIndex = 2
Top = 120
Width = 1335
End
Begin VB.CommandButton Command2
Caption = "Load Rpx2"
Height = 375
Left = 1320
TabIndex = 1
Top = 120
Width = 1335
End
Begin VB.CommandButton Command1
Caption = "Load Rpx1"
Height = 375
Left = 0
TabIndex = 0
Top = 120
Width = 1335
End
Begin DDActiveReportsDesignerCtl.ARDesigner ARD
Height = 8415
Left = 0
TabIndex = 3
Top = 600
Width = 8655
_ExtentX = 15266
_ExtentY = 14843
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Command1_Click()
Dim rpt As DDActiveReports2.ActiveReport
Set rpt = New ActiveReport
rpt.LoadLayout (App.Path & "\fmt01.rpx")
ARD.LoadFromObject rpt
End Sub
Private Sub Command2_Click()
Dim rpt As DDActiveReports2.ActiveReport
Set rpt = New ActiveReport
rpt.LoadLayout (App.Path & "\fmt02.rpx")
ARD.LoadFromObject rpt
End Sub
Private Sub Command3_Click()
End
End Sub
Private Sub Form_Load()
Dim rpt As DDActiveReports2.ActiveReport
Set rpt = New ActiveReport
'工具栏事件
Private Sub ABar_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool)
Dim rpt As DDActiveReports2.ActiveReport
Set rpt = New ActiveReport
'显示字体等工具
ARD.ToolbarsVisible = ddTBPropertyToolbox
ARD.ToolbarsAccessible = ddTBPropertyToolbox
Select Case Tool.Name
Case "named": '重命名
rename.Show 1
Case "reload": '
rpt.LoadLayout (App.Path & "\exfmt\fmt00.rpx")
ARD.LoadFromObject rpt
Case "options" '选项设置
F_DSG.Show 1
Case "save": '保存格式
If Len(Trim(fmtlist.Cell(flexcpText, fmtlist.RowSel, 1))) = 0 Then '如果别名为空,不保存
MsgBox Prompt:="尚未指定格式名称,无法保存!", Buttons:=vbOKOnly + vbExclamation, Title:="系统提示"
Else
ARD.SaveToObject rpt
rpt.SaveLayout App.Path & "\exfmt\" & fmtlist.Cell(flexcpText, fmtlist.RowSel, 2), ddSOFile
End If