vb(3) 将excel导入grid

Option Explicit


Private Sub Form_Load()
  Call msh_初始化
End Sub


Private Sub Form_Resize()
  With msh
    .Left = 0
    .Top = 0
    .Width = Me.ScaleWidth
    .Height = Me.ScaleHeight
  End With
End Sub
Private Sub msh_初始化()
  With msh
    .Clear
    .Cols = 1
    .Rows = 2
    .FixedCols = 0
    .FixedRows = 1
    .AllowUserResizing = flexResizeColumns
  End With
End Sub
Private Sub mnu导入Excel_Click()
  Dim xls As Excel.Application, xlsWorkBook As Excel.Workbook, xlsWorksheet As Excel.Worksheet
  Dim strFile As String, lngRows As Long, lngCols As Long, iRow As Long, iCol As Long, strCaption As String
  
  With cdg
    .DialogTitle = "导入Excel文件"
    .Filter = "Excel文件(*.xls)|*.xls|所有文件(*.*)|*.*"
    .ShowOpen
    strFile = .FileName
  End With
  If strFile = "" Then
     MsgBox "未选中文件！", vbOKOnly Or vbInformation, "提示"
     Exit Sub
  End If
  Set xls = CreateObject("Excel.Application")
  If xls Is Nothing Then
     MsgBox "未发现Excel组件，请检查！", vbOKOnly Or vbInformation, "提示"
     Exit Sub
  End If
  Set xlsWorkBook = xls.Workbooks.Open(strFile)
  Set xlsWorksheet = xlsWorkBook.Sheets(1)
  
  lngRows = xlsWorksheet.UsedRange.Rows.Count
  lngCols = xlsWorksheet.UsedRange.Columns.Count
  
  If lngRows >= 1 Or lngCols >= 1 Then
     If MsgBox("导入工作可能持续一段时间，您是否真的确定要导入?", vbOKCancel Or vbQuestion, "提示") = vbCancel Then
        Exit Sub
     End If
     Screen.MousePointer = vbHourglass
     strCaption = Me.Caption
     Call msh_初始化
     With msh
       .Cols = lngCols
       .Rows = lngRows
       For iRow = 1 To lngRows Step 1
           Me.Caption = "正在导入：" & iRow & " / " & lngRows
           For iCol = 1 To lngCols Step 1
               .TextMatrix(iRow - 1, iCol - 1) = xlsWorksheet.Cells(iRow, iCol)
           Next iCol
       Next iRow
       Me.Caption = strCaption
     End With
     Screen.MousePointer = vbDefault
     
  End If
  Set xlsWorksheet = Nothing
  Set xlsWorkBook = Nothing
  Set xls = Nothing
End Sub