frmmain.frm

Excel工作表导入MSFlexGrid中

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmMain 
   Caption         =   "Excel工作表导入MSFlexGrid中"
   ClientHeight    =   6555
   ClientLeft      =   2985
   ClientTop       =   2265
   ClientWidth     =   8160
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6555
   ScaleWidth      =   8160
   Begin VB.OptionButton Option2 
      Caption         =   "公式"
      Height          =   315
      Left            =   1680
      TabIndex        =   8
      Top             =   960
      Width           =   1455
   End
   Begin VB.OptionButton Option1 
      Caption         =   "值"
      Height          =   315
      Left            =   120
      TabIndex        =   7
      Top             =   960
      Value           =   -1  'True
      Width           =   1455
   End
   Begin VB.CommandButton Command2 
      Caption         =   "载入网格"
      Height          =   315
      Left            =   4665
      TabIndex        =   6
      Top             =   600
      Width           =   1260
   End
   Begin VB.ComboBox Combo1 
      Height          =   315
      Left            =   1440
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   600
      Width           =   3135
   End
   Begin VB.CommandButton Command1 
      Caption         =   "打开"
      Height          =   315
      Left            =   7410
      TabIndex        =   3
      Top             =   165
      Width           =   690
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Left            =   1440
      TabIndex        =   1
      Top             =   180
      Width           =   5865
   End
   Begin MSFlexGridLib.MSFlexGrid MSFlexGrid1 
      Height          =   5175
      Left            =   120
      TabIndex        =   0
      Top             =   1320
      Width           =   7935
      _ExtentX        =   13996
      _ExtentY        =   9128
      _Version        =   393216
      FixedRows       =   0
      FixedCols       =   0
   End
   Begin VB.Label Label2 
      Caption         =   "工作表："
      Height          =   195
      Left            =   135
      TabIndex        =   4
      Top             =   645
      Width           =   795
   End
   Begin VB.Label Label1 
      Caption         =   "XLS 文件："
      Height          =   255
      Left            =   120
      TabIndex        =   2
      Top             =   210
      Width           =   1215
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/07/04
'描  述：Excel工作表导入MSFlexGrid中
'网  站：http://www.mndsoft.com/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Sub Command1_Click()
    Dim OFName As OPENFILENAME
    Dim XLS As Object
    Dim WRK As Object
    Dim SHT As Object
    
    OFName.lStructSize = Len(OFName)
    '父窗体
    OFName.hwndOwner = Me.hWnd
    '程序实例
    OFName.hInstance = App.hInstance
    '文件过滤
    OFName.lpstrFilter = "Excel 文件 (*.xls)" + Chr$(0) + "*.xls" + Chr$(0) + "所有文件 (*.*)" + Chr$(0) + "*.*" + Chr$(0)
    '建立文件缓冲区
    OFName.lpstrFile = Space$(254)
    '返回文件的最大长度
    OFName.nMaxFile = 255
    '建立文件标题缓存区
    OFName.lpstrFileTitle = Space$(254)
    '返回文件标题最大长度
    OFName.nMaxFileTitle = 255
    '默认目录
    OFName.lpstrInitialDir = "C:\"
    '对话框标题
    OFName.lpstrTitle = "打开 XLS 文件"
    '无标志
    OFName.flags = 0

    '显示对话框
    If GetOpenFileName(OFName) Then
        Text1.Text = Trim$(OFName.lpstrFile)
        
        Combo1.Clear
        '建立Excel新实例
        Set XLS = CreateObject("Excel.Application")
        
        '打开XLS文件. UpdateLink = False 和 ReadOnly = True.
        Set WRK = XLS.Workbooks.Open(Text1.Text, False, True)
        '读取xls文件中的工作表
        For Each SHT In WRK.Worksheets
            '加载到列表框
            Combo1.AddItem SHT.Name
        Next
        '关闭并不保存
        WRK.Close False
        '退出MS Excel
        XLS.Quit
        
        '释放变量
        Set XLS = Nothing
        Set WRK = Nothing
        Set SHT = Nothing
    End If

End Sub


Private Sub Command2_Click()
On Error GoTo step_error
    Dim XLS As New Excel.Application
    Dim WRK As Excel.Workbook
    Dim SHT As Excel.Worksheet
    Dim RNG As Excel.Range
    
    Dim ArrayCells() As Variant
    
    If Combo1.ListIndex <> -1 Then
        '建立Excel新实例
        Set XLS = CreateObject("Excel.Application")
        '打开 XLS 文件
        Set WRK = XLS.Workbooks.Open(Text1.Text, False, True)
        '把当前选择的工作表赋值给SHT
        Set SHT = WRK.Worksheets(Combo1.List(Combo1.ListIndex))
        
        '得到当前工作表的使用范围
        Set RNG = SHT.UsedRange
        
        '重新分配数组
        ReDim ArrayCells(1 To RNG.Rows.Count, 1 To RNG.Columns.Count)
        
        '在使用范围内使用新的数组传值
        If Option1.Value Then
            ArrayCells = RNG.Value
        ElseIf Option2.Value Then
            ArrayCells = RNG.Formula
        End If
        
        '关闭工作表
        WRK.Close False
        '退出 Excel
        XLS.Quit
        
        '变量释放
        Set XLS = Nothing
        Set WRK = Nothing
        Set SHT = Nothing
        Set RNG = Nothing
        
        '网格数据显示设置
        MSFlexGrid1.Redraw = False
        MSFlexGrid1.FixedCols = 0
        MSFlexGrid1.FixedRows = 0
        MSFlexGrid1.Rows = UBound(ArrayCells, 1)
        MSFlexGrid1.Cols = UBound(ArrayCells, 2)
        
        For r = 0 To UBound(ArrayCells, 1) - 1
            For c = 0 To UBound(ArrayCells, 2) - 1
                MSFlexGrid1.TextMatrix(r, c) = CStr(ArrayCells(r + 1, c + 1))
            Next
        Next
        MSFlexGrid1.Redraw = True
    Else
        MsgBox "请选择一个工作表!", vbCritical, "提示"
        Combo1.SetFocus
    End If
Exit Sub
step_error:
MsgBox Err.Number & " - " & Err.Description
Resume Next
End Sub