7,763
社区成员
发帖
与我相关
我的任务
分享
Public Sub GetGuJiaFromExcel(ByVal fs As String, ByVal r1 As Long, ByVal r2 As Long) '''''打开Excel文件读取数据
On Error GoTo Ends:
Dim mybb As Variant
Dim i As Long
Dim j As Long
Dim hao1 As Long
Dim Index1 As Long
If r1 < 1 Then Exit Sub
If r2 < r1 Then Exit Sub
Set oExcel = CreateObject("excel.application")
oExcel.Visible = True
Set oBook = oExcel.Workbooks.Open(fs)
Set oSheet = oBook.Worksheets(1)
mybb = oExcel.Range(Cells(r1, 1), Cells(r2, 6))
For i = 1 To r2 - r1 + 1
hao1 = Val(mybb(i, 1))
Index1 = GetGuIndex(hao1)
If Index1 > 0 And Index1 <= nGu Then
Gu(Index1).TimJiaBefore = Val(mybb(i, 3))
Gu(Index1).TimJiaMax = Val(mybb(i, 4))
Gu(Index1).TimJiaMin = Val(mybb(i, 5))
Gu(Index1).TimJiaEnd = Val(mybb(i, 6))
End If
Next
Ends:
oExcel.Quit
Set oSheet = Nothing
Set oBook = Nothing
Set oExcel = Nothing
End Sub
'Form = Command1
'引用 Microsoft Excel 11.0 Object Library
'完成效果:在D盘下建立一个名字为 2的 excel文件 文件中的第5列第5行有“成功字样”
'*************下面是代码***************
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Private Sub Command1_Click()
Set xlapp = CreateObject("Excel.Application") '创建EXCEL对象
Set xlbook = xlapp.Workbooks.Add()
Set xlsheet = xlbook.Worksheets("Sheet1") '设置活动工作表
xlsheet.Cells(5, 5) = "成功" '向第五行第五列写入该数据
xlbook.SaveAs "D:.xls" '另存文件
xlbook.Close '关闭工作簿
Set xlbook = Nothing '从内存中清除
xlapp.Quit '关闭excel
Set xlapp = Nothing '从内存中清除
End Sub
'┏〓〓〓〓〓〓〓〓〓 GetExcelRs,start 〓〓〓〓〓〓〓〓〓┓
'[简介]:
'VB读取EXCEL工作薄某个表中数据
Function GetExcelRs(ByVal sFile As String, Optional ExcelSheetName As String = "sheet1", Optional ErrInfo As String) As ADODB.Recordset
'VB源码,帮你写函数,帮你写代码,帮你写模块,帮你设计软件
'--需要什么函数或功能,可以联系我。
'版权所有,请保留作者信息.QQ:1085992075
'如需商业用途请联系作者
On Error GoTo Err
Dim RS As ADODB.Recordset
Set RS = New ADODB.Recordset
Dim ConnStr As String
ConnStr = "DRIVER=Microsoft Excel Driver (*.xls);" & "DBQ=" & sFile & ";ReadOnly=False"
RS.Open "SELECT * FROM [" & ExcelSheetName & "$]", ConnStr, 1, 3
Set GetExcelRs = RS
Set RS = Nothing
Exit Function
Err:
ErrInfo = Err.Description
MsgBox ErrInfo
End Function
'┗〓〓〓〓〓〓〓〓〓 GetExcelRs,end 〓〓〓〓〓〓〓〓〓┛