VBA程序在工控电脑中一直运行良好,由于重先装完系统包括(XP,WINCC,EXCEL,),新建项目(是由WINCC项目复制器复制的,命名和旧项目不同),新建数据源连接,现在每次点击EXCEL窗口中的查询按钮,会出现以下错误:“-2147217865(80040e37) invalid object name “sheet1””。再把wincc和 sqlserver重新安装也不成,EXCEL中的程序没有更改过。
Microsoft Excel对象为sheet
Private Sub CommandButton1_Click()
UserForm1.Show
End Sub
窗体的程序为
Private Sub CommandButton1_Click()
'开始数据处理
Application.ScreenUpdating = False
Dim objConn As New ADODB.Connection
Dim objRs As New Recordset
objConn.ConnectionString = "FILEDSN=d:\report.dsn;" & "Uid=;" & "Pwd=;"
lnDate_start = FormatDateTime(Me.DTPicker_date1.Value, vbGeneralDate)
lnTime_start = FormatDateTime(Me.DTPicker_time1.Value, vbLongTime)
lnDate_end = FormatDateTime(Me.DTPicker_date2.Value, vbGeneralDate)
lnTime_end = FormatDateTime(Me.DTPicker_time2.Value, vbLongTime)
objConn.CursorLocation = 3
objConn.Open
strSqlSelect = "SELECT * From sheet1 where DateAndTime between '" & lnDate_start & " " & lnTime_start & "' and '" & lnDate_end & " " & lnTime_end & "'order by 1 "
'strSqlSelect = "SELECT DateAndTime, TagIndex, Val From FloatTable Union SELECT DateAndTime, TagIndex, Val FROM StringTable"
objRs.Open strSqlSelect, objConn
ActiveSheet.Unprotect Password:=10240
'清除显示区域
Range("A4:Z10000").ClearContents
Range("A4:Z10000").Font.Bold = False
'定义初始行号
Cells(4, 1).CopyFromRecordset objRs
Columns("A:A").NumberFormatLocal = "yyyy-m-d h:mm"
lnRec = objRs.RecordCount
Cells(lnRec + 4, 1).Value = "累计:"
If lnRec > 0 Then
For i = 3 To 9
Cells(lnRec + 4, i).Activate
ActiveCell.FormulaR1C1 = "=SUM(R[-" & lnRec & "]C:R[-1]C)"
Next i
End If
objRs.Close
Range("A4:W10000").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'设置格式线
lcRang = "A4:I" & CStr(lnRec + 4)
Range(lcRang).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'如果纪录小于等于1行不用设置内部格式线
If lnRec > 0 Then
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous Selection.Borders(xlEdgeTop).LineStyle = xlNone
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Cells(1, 1).Select
Application.ScreenUpdating = True
Me.Hide
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=10240
End Sub
Private Sub UserForm_Initialize()
Me.DTPicker_date1 = Date
Me.DTPicker_date2 = Date
Me.DTPicker_time2 = Now()
End Sub
请大家帮帮忙!