VBA代码填入数据并计算数据总和
我现在CAD中加入了一串代码，可以正常运行，这串代码可以自动启动excel，同时也可以自动关闭excel的，现在我要求在CAD的代码中增加代码，这个代码的要求是：自动计算excel某一列的数据总和，计算结果填入某一列中
[解决办法]
Private Sub Form_Load()
某列值累加并填写到另一列bt_Click
End Sub
Public Function GetExcelRs(ByVal sFile As String, Optional ExcelSheetName As String = "sheet1", Optional ErrInfo As String) As ADODB.Recordset
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
Public Function GetExcelRsBySql(ByVal sFile As String, Optional Sql As String, Optional ErrInfo As String) As ADODB.Recordset
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 Sql, ConnStr, 1, 3
Set GetExcelRsBySql = RS
Set RS = Nothing
Exit Function
Err:
ErrInfo = Err.Description
MsgBox ErrInfo
End Function
Private Sub 读写bt_Click()
Dim RS As ADODB.Recordset
Set RS = GetExcelRs(App.Path & "\book1.xls")
MsgBox RS.RecordCount
MsgBox RS(0)
RS(0) = Timer '更改内容
RS.CancelUpdate '取消更新
RS.Update '保存更新
RS.Close
End Sub
Private Sub 某列值累加并填写到另一列bt_Click()
Dim RS As ADODB.Recordset
Set RS = GetExcelRsBySql(App.Path & "\book1.xls", "select sum(订货数量) as 订货数量相加 from (SELECT * FROM [sheet1$])")
Dim 结果 As Long
结果 = RS(0)
MsgBox "相加的值是：" & 结果
RS.Close
Set RS = GetExcelRs(App.Path & "\book1.xls")
RS("总订货数量") = 结果
RS.Update
MsgBox "保存后字段[总订货数量] 的值是：" & RS("总订货数量")
RS.Close
End Sub
