高手：在IE中的表格打印时，怎样调用EXECL把表格的内容读入到EXECL中！

老兄：你是理解错了吧！我的意思是我的显示是用表格，提供打印的按钮；当点击打印时，调用EXECL，把我的表格的数据读入到EXECL中；

写一个Bean将页面表格的数据读入到EXECL。
用空格分隔将数据保存为.xls。
或用","分隔将数据保存为.csv。

可用activex控件我这有现成的程序，参数是一个很长的字符串。每个单元格用!@!分开，每行用!*!分开。你先看看吧。
VERSION 5.00
Begin VB.UserControl A_Print
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   1140
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6525
   ScaleHeight     =   1140
   ScaleWidth      =   6525
   Begin VB.CommandButton cb_Print
      Caption         =   "打印"
      Height          =   180
      Left            =   0
      TabIndex        =   0
      Top             =   1080
      Visible         =   0   'False
      Width           =   495
   End
   Begin VB.Label Label1
      BackColor       =   &H00FFFFFF&
      BeginProperty Font
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   0
      TabIndex        =   1
      Top             =   360
      Width           =   6375
   End
End
Attribute VB_Name = "A_Print"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

    Private exA As New Excel.Application
    Private exWB As Excel.Workbook
    Private exWS As Excel.Worksheet
    'Private Str_FileName  As String 'Excel文件

    '================
    '=================Excel对象的定义
    '=============================外来参数
    Public Rep_Type  As String '报表类型
    Public Rep_Title As String '报表标题，
    Public Arg_Up    As String '报表上参数，各参数中间用"!@!"隔开，分割符单字节
    Public Arg_Down  As String '报表下参数，各参数中间用"!@!"隔开，分割符单字节
    Public Rep_Arr   As String '报表的数组参数，每个数据之间用"!@!"隔开，每行数据用"!*!"隔开，分割符为单字节

    Public Rep_Column_Width  As String '报表的列宽，各参数中间用"!@!"隔开，各参数必须可以转换为数字，分割符单字节
    Public Rep_Row_Height As String  '报表的行高，各参数中间用"!@!"隔开，各参数必须可以转换为数字，分割符单字节

    Public Rep_UpRows As Integer '报表的表头行数，
    Public Rep_DownRows As Integer '报表的最下行需要合并的行数
    Public Rep_MidRows  As Integer '报表的中间需要合并的行数(必须是整行合并)
    Public Rep_LeftColumns As Integer '报表的左表头需要合并的列数    '以上各个参数字符型参数默认值为空字符串""，数字型参数默认值为0

    '==========内部用参数==============
    '===================
    'Private Str_Title As String '报表标题
    Private Arr_Up()  As String '报表上参数  分解Arg_Up
    Private Arr_Down() As String '报表下参数分解Arg_Down
    Private Arr_Str1() As String
    Private Arr_Str2() As String
    Private Arr_Str3() As String '2维数组，1 To A_i,1 to A_j

    Private Arr_Width() As String '报表宽度  分解 Rep_Column_Width
    Private Arr_Height() As String '报表高度  分解Rep_Row_Height

    Private Arr_Lin() As String '报表的临时数组
    Private Str_lin As String '报表的临时字符串参数

    Private B_i, B_j As Integer '报表的行数，列数
    Private i, j, k As Integer '循环变量

接上一贴
Public Sub R_Print()    Arg_Up = Replace(Arg_Up, "null", "  ")

    If Printers.Count < 1 Then
        MsgBox "你的机器不存在打印机!", vbOKOnly, "打印错误"
        Exit Sub
    End If
   '---------------------------------
    w ("检查完毕,正在检查参数请稍候.....")


    If Trim(Rep_Title) = "" Then '报表标题不能为空
        MsgBox "报表标题不能为空，报表参数Rep_Title错误！", vbOKOnly, "打印错误"
        Label1.Caption = ""
        Label1.Refresh
        Exit Sub
    End If
    Arr_Up = Split(Arg_Up, "!@!")
    Arr_Down = Split(Arg_Down, "!@!")

    Arr_Str2() = Split(Rep_Arr, "!*!")
    B_i = UBound(Arr_Str2) + 1
    If B_i < 2 Then
        MsgBox "报表的数组参数Rep_Arr错误！", vbOKOnly, "打印错误"
        Label1.Caption = ""
        Label1.Refresh
        Exit Sub
    End If
    B_j = UBound(Split(Arr_Str2(0), "!@!")) + 1 '数组参数的列数
    If B_j < 2 Then
        MsgBox "报表的数组参数Rep_Arr错误！", vbOKOnly, "打印错误"
        Label1.Caption = ""
        Label1.Refresh
        Exit Sub
    End If

    ReDim Arr_Str3(1 To B_i, 1 To B_j) '重新定义数组的长宽
    For i = 1 To B_i
        Arr_Lin = Split(Arr_Str2(i - 1), "!@!")
        If B_j <> UBound(Arr_Lin) + 1 Then
            MsgBox "报表的数组参数Rep_Arr存在问题，例如第1行数据个数与第" + str(i) + "行数据个数不同", vbOKOnly, "打印错误"
            'MsgBox Rep_Arr, vbOKOnly, "数组数据"
            'MsgBox Arr_Str2(i - 1), vbOKOnly, Str(i) + "行数据"
            Label1.Caption = ""
            Label1.Refresh
            Exit Sub
        End If
        For j = 1 To B_j
            Arr_Str3(i, j) = Arr_Lin(j - 1)    '报表的各行参数
        Next
    Next

    If B_i < Rep_UpRows + Rep_DownRows + Rep_MidRows Then
        MsgBox "报表参数错误存在错误！请仔细检查", vbOKOnly, "打印错误"
        Label1.Caption = ""
        Label1.Refresh
        Exit Sub
    End If

    If B_j < Rep_LeftColumns Then
        MsgBox "报表参数错误存在错误！请仔细检查", vbOKOnly, "打印错误"
        Label1.Caption = ""
        Label1.Refresh
        Exit Sub
    End If

    Arr_Width = Split(Rep_Column_Width, "!@!")
    If UBound(Arr_Width) > 0 Then '检查列宽是不是都为数字
        For i = 0 To UBound(Arr_Width)
            If IsNumeric(Arr_Width(i)) = False Then
                MsgBox "报表列宽参数Rep_Column_Width存在问题，各个小参数必须为可以转化为数字", vbOKOnly, "打印错误"
            End If
        Next

    End If
    Arr_Height = Split(Rep_Row_Height, "!@!")
    If UBound(Arr_Height) > 0 Then '检查行高是不是都为数字
        For i = 0 To UBound(Arr_Height)
            If IsNumeric(Arr_Height(i)) = False Then
                MsgBox "报表列宽参数Rep_Row_Height存在问题，各个小参数必须为可以转化为数字", vbOKOnly, "打印错误"
            End If
        Next
    End If

接上一贴    'On Error GoTo E_CreateExcel '客户机中是否安装了Excel
    Set exA = CreateObject("excel.application")
    Set exWB = exA.Workbooks.Add
    Set exWS = exWB.Worksheets("sheet1")
    If 1 = 2 Then
E_CreateExcel:        MsgBox "无法创建Excel对象,请确认你的计算机中是否安装了Excel", vbOKOnly, "打印错误"
           Exit Sub
    End If
    exA.Visible = False
    '=======================================================================
    'On Error Resume Next  '错误，继续执行

    '设置列宽
    If UBound(Arr_Width) > 0 Then '
        For i = 0 To UBound(Arr_Width)
            exWS.Cells(1, i + 1).ColumnWidth = CDbl(Arr_Width(i))
        Next
    End If
    '设置行高
    If UBound(Arr_Height) > 0 Then '
        For i = 0 To UBound(Arr_Height)
            exWS.Cells(i + 1, 1).RowHeight = CDbl(Arr_Height(i))
        Next
    End If
    '设置报表标题
    exWS.Range(exWS.Cells(1, 1), exWS.Cells(1, B_j)).Merge
    exWS.Cells(1, 1).Font.Size = 16
    exWS.Cells(1, 1).Font.Bold = True
    exWS.Cells(1, 1).Font.Underline = True
    exWS.Cells(1, 1).HorizontalAlignment = xlCenter
    exWS.Cells(1, 1).Value = Rep_Title
    '设置报表上数据参数

    '设置报表下数据参数

    '合并表头单元格
    Label1.Caption = "正在合并表头单元格....."
    Label1.Refresh

        If Rep_UpRows >= 1 Then
            For i = 1 To Rep_UpRows  '横向合并
                For j = B_j To 2 Step -1
                    If Arr_Str3(i, j) = Arr_Str3(i, j - 1) Then
                       exWS.Range(exWS.Cells(i + 2, j - 1), exWS.Cells(i + 2, j)).Merge
                    End If
                Next
            Next
            For j = 1 To B_j  '纵向合并竖向
                For i = Rep_UpRows To 2 Step -1   'Rep_upRows=1  无法执行
                    If Arr_Str3(i, j) = Arr_Str3(i - 1, j) Then
                        exWS.Range(exWS.Cells(i + 2, j), exWS.Cells(i + 2 - 1, j)).Merge
                    End If
                Next
            Next
        End If    '合并表的最下方单元格
    Label1.Caption = "正在合并表的最下方单元格....."
    Label1.Refresh
        If Rep_DownRows >= 1 Then
            For i = B_i - Rep_DownRows + 1 To B_i '横向合并
                For j = B_j To 2 Step -1
                    If Arr_Str3(i, j) = Arr_Str3(i, j - 1) Then
                       exWS.Range(exWS.Cells(i + 2, j - 1), exWS.Cells(i + 2, j)).Merge
                    End If
                Next
            Next
            For j = 1 To B_j  '纵向合并竖向
                For i = B_i To B_i - Rep_DownRows + 1 Step -1 'Rep_upRows=1  无法执行
                    If Arr_Str3(i, j) = Arr_Str3(i - 1, j) Then
                        exWS.Range(exWS.Cells(i + 2, j), exWS.Cells(i + 2 - 1, j)).Merge
                    End If
                Next
            Next
        End If
    '合并中间的单元格只有横向合并
     Label1.Caption = "正在合并表的合并中间的单元格....."
     Label1.Refresh
        If Rep_MidRows > 0 Then
            For i = Rep_UpRows + 1 To B_i - Rep_DownRows
                Str_lin = Arr_Str3(i, 1)
                For j = 2 To B_j
                    If Str_lin <> Arr_Str3(i, j) Then
                        Exit For
                    End If
                    If j = B_j Then
                        exWS.Range(exWS.Cells(i + 2, 1), exWS.Cells(i + 2, B_j)).Merge
                    End If
                Next
            Next
        End If
    '合并左表头单元格
     Label1.Caption = "正在合并表的左表头单元格....."
     Label1.Refresh
        If Rep_LeftColumns > 0 Then
            For i = 1 To B_i  '横向合并
                For j = Rep_LeftColumns To 2 Step -1
                    If Arr_Str3(i, j) = Arr_Str3(i, j - 1) Then
                       exWS.Range(exWS.Cells(i + 2, j - 1), exWS.Cells(i + 2, j)).Merge
                    End If
                Next
            Next
            For j = 1 To Rep_LeftColumns  '纵向合并竖向
                For i = B_i To 2 Step -1   'Rep_upRows=1  无法执行
                    If Arr_Str3(i, j) = Arr_Str3(i - 1, j) Then
                        exWS.Range(exWS.Cells(i + 2, j), exWS.Cells(i + 2 - 1, j)).Merge
                    End If
                Next
            Next
        End If
    '==================================

调试易

高手：在IE中的表格打印时，怎样调用EXECL把表格的内容读入到EXECL中！

解决方案 »