2019新年好礼！还有10天就过年了！
        期末时用易语言写了一个excel自动填表工具，觉得易语言的对象操作语法太过另类，写起来比较费劲。这时就特别怀念VB那种世界上最接近人类自然语言的语法。比较起来，对于office操作，还是VB更简单、更快捷，毕竟都是Microsoft自家的同门兄弟啊，呵呵。于是利用年前闲暇，用VB6写了一个excel读写操作模块，即使一点也不懂VBA、不会写公式的新手，也可以拿来直接调用，excel自动填表不再是难事。留个备份在网上，免得下次用时又找不到了。
胡子软件工作室 
2019.1.27

VB6之excel读写模块.bas

胡子先生注：全部函数名和过程名一律用英文定义，基本上都能从名称上看出函数的用途。如果喜欢用中文，建议根据后面的注释改成相应的中文名即可，VB6支持中文过程、函数名，也支持中文变量名。不过VB中输入中文远不如易语言方便快捷（易语言是我见过的世界上输入代码最快的编程语言，没有之一），所以强烈不建议用中文名。

'VB6之excel读写模块
'-------------------------------------------------
'1、exCreateApp()                                                                '创建excel对象
'2、exGetApp()                                                                     '获取excel对象
'3、exClose()                                                                   '关闭释放excel
'4、exSave()                                                                            '保存工作薄
'5、exSaveAs(filename)                                                           '另存工作薄
'6、exOpen(xlsFile As String)                                                   '打开工作薄
'7、exVisible(tf As Boolean)                                                    '可视
'8、exGetText(rag As String) As String                                     '读单元格
'9、exSetText(rag As String, txt As String)                                '写单元格
'10、exActiveCell(rag)                                                                '置活动单元格
'11、exGetRows() As Integer                                                   '取有效行数
'12、exGetColumns() As Integer                                              '取有效列数
'13、exAutofix()                                                                     '自动调整列宽
'14、exSetColor_Font(rag As String, fntcolor As Long)                  ' 置单元格字体颜色(vbRed,vbGreen)
'15、exSetcolor_Interior(rag As String, colorx As Long)                 ' 置底纹颜色
'16、exSetBorders(rag As String)                                                 '添加边框线
'17、exActiveWorkbook(workbookName As String) As Boolean        ' 激活工作薄，按工作薄名
'18、exActiveWorkbook1(index As Integer)                                      ' 激活工作薄1，按序号
'19、exActiveSheet(sheetName As String)                                          '激活工作表
'20、exSaved(tf As Boolean)                                                   '退出不提示保存
'21、exActiveCell(row, col)                                                      '置活动单元格
'22、exExistObj(obj As Object) As Boolean                                   '对象是否存在
'23、exCellToAry1(rng As String, ary() As String) As Integer        ' 单元格区域到一维数组，从1开始，返回成员数量（适用于单列或单行数据，如A1:A9）
'24、exCellToAry2(rng As String, ary() As String)            ' 单元格区域到二维数组（适用于多行多列数据，如A2:F8）
'25、exRngxy(rng As String, x As Integer, y As Integer)  ' 取区域行列数，需要定义两个整型变量接收返回的行数、列数（各维最大下标）
'26、exGetAryText(ary() As String, row As Integer, col As Integer) As String         ' 读二维数组文本
'
'-------------------------------------------------

Public excel As Object                                                          'As excel.Application
Public workbook As Object                                                       'As excel.workbook
Public sheet As Object                                                          'As excel.Worksheet

Sub exCreateApp()                                                               '创建excel对象
    Set excel = CreateObject("excel.application")
End Sub

Sub exGetApp()                                                                  '获取excel对象
    'getobject(pathName,Class)
    Set excel = GetObject(, "excel.application")
    Set workbook = excel.activeworkbook
End Sub

Sub exClose()                                                                   '关闭释放excel
    If Not workbook Is Nothing Then
        workbook.Close
        Set workbook = Nothing
    End If
    If Not excel Is Nothing Then
        excel.Quit
        Set excel = Nothing
    End If
End Sub

Sub exSave()                                                                    '保存工作薄，不提示
    'excel.activeworkbook.Saved = True
    excel.activeworkbook.Save
End Sub

Sub exSaveAs(filename)                                                          '另存工作薄
    excel.activeworkbook.SaveAs filename
End Sub

Sub exOpen(xlsFile As String)                                                   '打开工作薄
    Set workbook = excel.workbooks.Open(xlsFile)
End Sub

Sub exVisible(tf As Boolean)                                                    '可视
    excel.Visible = tf
End Sub

Function exGetText(rng As String) As String                                     '读单元格
    exGetText = excel.range(rng).Value
End Function

Sub exSetText(rng As String, txt As String)                                     '写单元格
    excel.range(rng).Value = txt
End Sub

Function exGetRows() As Integer                                                 '取有效行数
    exGetRows = excel.activesheet.UsedRange.Rows.Count
End Function

Function exGetColumns() As Integer                                              '取有效列数
    exGetColumns = excel.activesheet.UsedRange.Columns.Count
End Function

Sub exAutofix()                                                                 '自动调整列宽
    excel.Cells.EntireColumn.AutoFit
End Sub

Sub exSetColor_Font(rng As String, colorx As Long)                              '置单元格字体颜色(vbRed,vbGreen),OK
    'excel.activesheet.range(rng).Font.ColorIndex = colorx
    'ColorIndex 是VBA颜色序号，取值范围为（1－56），
    '改为Color 可以使用VB颜色值
    excel.activesheet.range(rng).Font.Color = colorx
End Sub

Sub exSetColor_Interior(rng As String, colorx As Long)          ' 置底纹颜色,(vbRed,vbGreen)
    'excel.range(rng).interior.ColorIndex = colorx
    excel.range(rng).interior.Color = colorx
End Sub

Sub exSetBorders(rng As String)                                                 '添加边框线
    excel.range(rng).Borders(1).Weight = 2
    excel.range(rng).Borders(2).Weight = 2
    excel.range(rng).Borders(3).Weight = 2
    excel.range(rng).Borders(4).Weight = 2
    '1-左 2-右 3-顶 4-底 5-斜( \ ) 6-斜( / )
    'Weight = 1,虚线；2,细实线；3,粗实线
End Sub

Function exActiveWorkbook(workbookName As String) As Boolean                    ' 激活工作薄，按工作薄名
    Dim x As Integer, ntt As String, isntt As Boolean
    x = excel.workbooks.Count
    isntt = False
    For i = 1 To x
        ntt = excel.workbooks(i).Name
        If ntt = workbookName Then
            isntt = True
            Exit For
        End If
    Next
    If isntt = True Then
        excel.workbooks.Item(i).Activate
        exActiveWorkbook = True
    Else
        exActiveWorkbook = False
    End If
End Function

Sub exActiveWorkbook1(index As Integer)                                         ' 激活工作薄1，按序号
    excel.workbooks.Item(index).Activate
End Sub

Sub exActiveSheet(sheetName As String)                                          '激活工作表
    Set sheet = excel.Sheets(sheetName)
    sheet.Activate
End Sub

Sub exSaved(tf As Boolean)                                                      '退出不提示保存
    '    excel.activeworkbook.Saved = tf
    If Not excel Is Nothing Then
        excel.DisplayAlerts = False
    End If
End Sub

Sub exActiveCell(rng)                                                           '置活动单元格
    'excel.activesheet.Cells(row, col).Select
    excel.activesheet.range(rng).Select
End Sub

Function exExistObj(obj As Object) As Boolean                                   '对象是否存在
    If Not obj Is Nothing Then
        exExistObj = True
    Else
        exExistObj = False
    End If
End Function

Function exCellToAry1(rng As String, ary() As String) As Integer   ' 单元格区域到一维数组，从1开始，返回成员数量
    ' 胡子注：适用于单列或单行数据，如A1:A9
    'ary = excel.activesheet.range(rng).Value  'VBA语法，此处无效
    Dim iRng, iCell
    Dim x As Integer, Y As Integer, n As Integer
    iRng = excel.range(rng)
    exRngxy rng, x, Y
    ReDim ary(x * Y)
    n = 1
    For Each iCell In iRng
        ary(n) = CStr(iCell)
        n = n + 1
    Next
    exCellToAry1 = x * Y
End Function

Sub exCellToAry2(rng As String, ary() As String)    ' 单元格区域到二维数组，胡子注：适用于多行多列数据，如A2:F8
    Dim iRng, iCell
    Dim x As Integer, Y As Integer
    Dim lsary() As String
    Dim m As Integer, n As Integer, i As Integer, j As Integer
    
    iRng = excel.range(rng)
    exRngxy rng, x, Y
    ReDim lsary(x * Y)
    
    m = 1
    For Each iCell In iRng
        lsary(m) = CStr(iCell)
        m = m + 1
    Next
    
    ReDim ary(x, Y)
    n = 1
    For i = 1 To Y
        For j = 1 To x
            ary(j, i) = lsary(n)
            n = n + 1
        Next
    Next
End Sub

Function exGetAryText(ary() As String, row As Integer, col As Integer) As String ' 读单元格数组文本
    exGetAryText = ary(row, col)
    '返回数组中第row行，第col列的值
End Function

Sub exRngxy(rng As String, x As Integer, Y As Integer)     '取区域行列数(不含0)，需要定义两个整型变量接收返回的行数、列数（各维最大下标）
    '    excel.activesheet.range(rng).Select
    x = excel.range(rng).Rows.Count
    Y = excel.range(rng).Columns.Count
End Sub