Problema con Visual Basic y Excel
Publicado por Omar Leonardo Gil (3 intervenciones) el 16/12/2011 21:13:43
Buenos dias tengo una aplicacion en Visual Basic 6 en mi maquina y corre de forma adecuada al instalarla en otra maquina con windows XP SP3 me da este mensaje que puede hacer ya he hecho todo lo que han dicho en el foro alguien me puede ayudar
Run time error 430 class does not support Automation or does not support expected interface
este es el codigo
Private oConn As ADODB.Connection
Private nBasic As Currency
Private cQualifications As String
Private cExperience As String
Private nPorcentaje As Currency, nCalBonus As Currency, nAllowance As Currency, nCalBonPs As Currency, nBonoReal As Currency
Private nSalInt As Currency, nAuxMon As Currency, nSueldoSinPlus As Currency, nCalBon As String, nRent As Currency
Private nMonthly As Currency, nGross As Currency, nAnualIn As Currency, nAnualGross As Currency
'Cursores
Private oRSQualifications As ADODB.Recordset
Private oRSExperience As ADODB.Recordset
Private oRSResponsabilities As ADODB.Recordset
Private oRSResponsabilitiesBus As ADODB.Recordset
Private oRSsQLPorcentajes As ADODB.Recordset
Private Sub Command1_Click()
ActualizaTxt
CalculaBonosUS
End Sub
Private Sub Command2_Click()
Me.Hide
End Sub
Private Sub Form_Load()
Dim nCols As Integer
Dim i As Integer, cadena As String
' Cursores
sDataTemplate = App.Path & "\Calculadora.xls"
Set oConn = New ADODB.Connection
'Open the ADO connection to the Excel workbook
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDataTemplate & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
' Llena Qualifications
Set oRSQualifications = New ADODB.Recordset
oRSQualifications.Open "[Qualifications$]", oConn, adOpenStatic, adLockOptimistic
nCols = oRSQualifications.RecordCount
If oRSQualifications.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSQualifications.Close
Exit Sub
Else
nCols = oRSQualifications.RecordCount
oRSQualifications.MoveFirst
For i = 1 To nCols
If Len(Trim(oRSQualifications.Fields("QualificationID").Value)) > 0 Then
cadena = Trim(oRSQualifications.Fields("QualificationID").Value) & " - " & Trim(oRSQualifications.Fields("Description").Value)
Combo(0).AddItem cadena
End If
oRSQualifications.MoveNext
Next
Combo(0).ListIndex = 0
End If
' Llena Experience
Set oRSExperience = New ADODB.Recordset
oRSExperience.Open "[Experience$]", oConn, adOpenStatic, adLockOptimistic
nCols = oRSExperience.RecordCount
If oRSExperience.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSExperience.Close
Exit Sub
Else
nCols = oRSExperience.RecordCount
oRSExperience.MoveFirst
For i = 1 To nCols
If Len(Trim(oRSExperience.Fields("ExperienceID").Value)) > 0 Then
cadena = Trim(oRSExperience.Fields("ExperienceID").Value) & " - " & Trim(oRSExperience.Fields("Description").Value)
Combo(1).AddItem cadena
End If
oRSExperience.MoveNext
Next
Combo(1).ListIndex = 0
End If
' Llena Responsabilities
Set oRSResponsabilities = New ADODB.Recordset
oRSResponsabilities.Open "[Responsabilities$]", oConn, adOpenStatic, adLockOptimistic
nCols = oRSResponsabilities.RecordCount
If oRSResponsabilities.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSResponsabilities.Close
Exit Sub
Else
nCols = oRSResponsabilities.RecordCount
oRSResponsabilities.MoveFirst
For i = 1 To nCols
If Len(Trim(oRSResponsabilities.Fields("ResponsabilitiesID").Value)) > 0 Then
cadena = Trim(oRSResponsabilities.Fields("ResponsabilitiesID").Value) & " - " & Trim(oRSResponsabilities.Fields("Description").Value)
Combo(2).AddItem cadena
End If
oRSResponsabilities.MoveNext
Next
Combo(2).ListIndex = 0
End If
' ActualizaTxt
'CalculaBonosUS
LimpiaTxt
End Sub
Private Sub ActualizaTxt()
Dim cRes As String, Basic As Currency
Set oRSResponsabilitiesBus = New ADODB.Recordset
'oRSResponsabilitiesBus.Open "[Responsabilities$]", oConn, adOpenStatic, adLockOptimistic
cRes = Left(Combo(2), 2)
oRSResponsabilitiesBus.Open "Select * from [Responsabilities$] Where ResponsabilitiesID = '" & Trim(cRes) & "'", oConn, adOpenStatic, adLockOptimistic
' Carga datos de los salarios
' Set SQLResponsabilitiesBus = cnPpal.Execute("SELECT * FROM Responsabilities Where ResponsabilitiesID = '" & Trim(cRes) & "'", , 1)
If Not oRSResponsabilitiesBus.EOF Then
Txtcampo(0).Text = Format(oRSResponsabilitiesBus.Fields("Basic").Value, "###,##0.00")
Txtcampo(1).Text = Format(oRSResponsabilitiesBus.Fields("Allowance").Value, "###,##0.00")
Txtcampo(2).Text = Format(oRSResponsabilitiesBus.Fields("MonthlySalary").Value, "###,##0.00")
Txtcampo(10).Text = Format(oRSResponsabilitiesBus.Fields("rent").Value, "###,##0.00")
Txtcampo(8).Text = Format(oRSResponsabilitiesBus.Fields("rent").Value * 12, "###,##0.00")
End If
End Sub
Private Sub Combo_Click(Index As Integer)
Select Case Index
Case 0
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 1
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 2
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
' Case 3
' CambiaCombo lctipo1
' Case 6
' ActualizaTxt
' CalculaBonosPS
End Select
End Sub
Private Sub Combo_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
bSalir = False
If vbKeyEscape = KeyCode Then
bSalir = True
Unload Me
End If
' CampoTeclasEsp KeyCode, Shift
End Sub
Private Sub Combo_KeyPress(Index As Integer, KeyAscii As Integer)
If vbKeyEscape = KeyAscii Then
bSalir = True
Unload Me
End If
If vbKeyReturn = KeyAscii Then KeyAscii = 0 ' no importa que digite
End Sub
Private Sub Combo_LostFocus(Index As Integer)
Select Case Index
Case 0
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 1
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 2
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
' Case 3
' CambiaCombo lctipo1
' Case 6
' ActualizaTxt
' CalculaBonosPS
End Select
End Sub
Public Sub CalculaBonosUS()
Dim cadena As String
Set oRSsQLPorcentajes = New ADODB.Recordset
nBasic = Txtcampo(0).Text
nAllowance = Txtcampo(1).Text
cQualifications = Left(Combo(0), 1)
cExperience = Left(Combo(1), 1)
nMonthly = Txtcampo(2).Text
oRSsQLPorcentajes.Open "Select * from [Escalas$] where EscalaID = '" & Trim(cQualifications) & "'", oConn, adOpenStatic, adLockOptimistic
' Obtiene el calculo del porcentaje
' Set SQLPorcentajes = cnPpal.Execute("SELECT * FROM Porcentajes where PorcentajeID = '" & Trim(cQualifications) & "'", , 1)
If oRSsQLPorcentajes.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSsQLPorcentajes.Close
Exit Sub
Else
nPorcentaje = oRSsQLPorcentajes.Fields("por" & cExperience).Value
' oRSResponsabilitiesBus.Fields("Basic").Value
End If
nCalBonus = (nBasic * nPorcentaje) + nAllowance
nBonoReal = nCalBonus
nSalInt = (Txtcampo(2).Text) * 0.7
nAuxMon = nSalInt * 100 / 70 * 30 / 100
nSueldoSinPlus = nSalInt + nAuxMon
nCalBon = ((nBonoReal - nSueldoSinPlus) * 14 + nBonoReal * 2 + (nBonoReal - nSueldoSinPlus) * 0.12) / 2
' nAnnualGross = Txtcampo(8).Text + Txtcampo(9).Text
Txtcampo(3).Text = Format(nCalBonus, "###,##0.00")
Txtcampo(7).Text = Left(Combo(0), 1) & Left(Combo(1), 1) & Left(Combo(2), 2)
Txtcampo(4).Text = Format(nCalBon, "###,##0.00")
Txtcampo(5).Text = Format(nCalBon, "###,##0.00")
Txtcampo(6).Text = Format(nCalBon * 2, "###,##0.00")
Txtcampo(9).Text = Format((nCalBon * 2) + (nMonthly * 14), "###,##0.00")
nAnualIn = Txtcampo(9).Text
nAnualGross = Txtcampo(8).Text
Txtcampo(11).Text = Format(nAnualIn + nAnualGross, "###,##0.00")
End Sub
Private Sub CambiaCombo(lctipo1 As String)
If Combo(3).ListIndex = 0 Then
' Carga Combo de Responsabilidad Combo 6
Set SQLResponsabilidad = cnPpal.Execute("SELECT * FROM responsabilidades ", , 1)
If SQLResponsabilidad.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
SQLResponsabilidad.Close
Exit Sub
Else
Final = SQLResponsabilidad.RecordCount
Combo(6).Clear
SQLResponsabilidad.MoveFirst
For i = 1 To Final
cadena = Trim(SQLResponsabilidad("ResponsabilidadID")) & " - " & Trim(SQLResponsabilidad("Descripcion"))
Combo(6).AddItem cadena
SQLResponsabilidad.MoveNext
Next
Combo(6).ListIndex = 0
End If
ActualizaTxt
' CalculaBonosUS
Else
' Carga Combo de Responsabilidad Combo 6
Set SQLResponsabilidadNB = cnPpal.Execute("SELECT * FROM responsabilidadesNB ", , 1)
If SQLResponsabilidadNB.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
SQLResponsabilidadNB.Close
Exit Sub
Else
Final = SQLResponsabilidadNB.RecordCount
Combo(6).Clear
SQLResponsabilidadNB.MoveFirst
For i = 1 To Final
cadena = Trim(SQLResponsabilidadNB("ResponsabilidadID")) & " - " & Trim(SQLResponsabilidadNB("Descripcion"))
Combo(6).AddItem cadena
SQLResponsabilidadNB.MoveNext
Next
Combo(6).ListIndex = 0
End If
ActualizaTxt
' CalculaBonosUS
End If
End Sub
Private Sub LimpiaTxt()
Txtcampo(0).Text = Format(0, "###,##0.00")
Txtcampo(2).Text = Format(0, "###,##0.00")
Txtcampo(3).Text = Format(0, "###,##0.00")
Txtcampo(4).Text = Format(0, "###,##0.00")
Txtcampo(5).Text = Format(0, "###,##0.00")
Txtcampo(6).Text = Format(0, "###,##0.00")
Txtcampo(8).Text = Format(0, "###,##0.00")
Txtcampo(9).Text = Format(0, "###,##0.00")
Txtcampo(10).Text = Format(0, "###,##0.00")
Txtcampo(11).Text = Format(0, "###,##0.00")
End Sub
Private Sub Form_Unload(Cancel As Integer)
oRSQualifications.Close
oRSExperience.Close
oRSResponsabilities.Close
' If rDBCursor Is Nothing Then Else rDBCursor.Close
If oRSResponsabilitiesBus Is Nothing Then Else oRSResponsabilitiesBus.Close
If oRSsQLPorcentajes Is Nothing Then Else oRSsQLPorcentajes.Close
End Sub
Run time error 430 class does not support Automation or does not support expected interface
este es el codigo
Private oConn As ADODB.Connection
Private nBasic As Currency
Private cQualifications As String
Private cExperience As String
Private nPorcentaje As Currency, nCalBonus As Currency, nAllowance As Currency, nCalBonPs As Currency, nBonoReal As Currency
Private nSalInt As Currency, nAuxMon As Currency, nSueldoSinPlus As Currency, nCalBon As String, nRent As Currency
Private nMonthly As Currency, nGross As Currency, nAnualIn As Currency, nAnualGross As Currency
'Cursores
Private oRSQualifications As ADODB.Recordset
Private oRSExperience As ADODB.Recordset
Private oRSResponsabilities As ADODB.Recordset
Private oRSResponsabilitiesBus As ADODB.Recordset
Private oRSsQLPorcentajes As ADODB.Recordset
Private Sub Command1_Click()
ActualizaTxt
CalculaBonosUS
End Sub
Private Sub Command2_Click()
Me.Hide
End Sub
Private Sub Form_Load()
Dim nCols As Integer
Dim i As Integer, cadena As String
' Cursores
sDataTemplate = App.Path & "\Calculadora.xls"
Set oConn = New ADODB.Connection
'Open the ADO connection to the Excel workbook
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDataTemplate & ";" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
' Llena Qualifications
Set oRSQualifications = New ADODB.Recordset
oRSQualifications.Open "[Qualifications$]", oConn, adOpenStatic, adLockOptimistic
nCols = oRSQualifications.RecordCount
If oRSQualifications.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSQualifications.Close
Exit Sub
Else
nCols = oRSQualifications.RecordCount
oRSQualifications.MoveFirst
For i = 1 To nCols
If Len(Trim(oRSQualifications.Fields("QualificationID").Value)) > 0 Then
cadena = Trim(oRSQualifications.Fields("QualificationID").Value) & " - " & Trim(oRSQualifications.Fields("Description").Value)
Combo(0).AddItem cadena
End If
oRSQualifications.MoveNext
Next
Combo(0).ListIndex = 0
End If
' Llena Experience
Set oRSExperience = New ADODB.Recordset
oRSExperience.Open "[Experience$]", oConn, adOpenStatic, adLockOptimistic
nCols = oRSExperience.RecordCount
If oRSExperience.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSExperience.Close
Exit Sub
Else
nCols = oRSExperience.RecordCount
oRSExperience.MoveFirst
For i = 1 To nCols
If Len(Trim(oRSExperience.Fields("ExperienceID").Value)) > 0 Then
cadena = Trim(oRSExperience.Fields("ExperienceID").Value) & " - " & Trim(oRSExperience.Fields("Description").Value)
Combo(1).AddItem cadena
End If
oRSExperience.MoveNext
Next
Combo(1).ListIndex = 0
End If
' Llena Responsabilities
Set oRSResponsabilities = New ADODB.Recordset
oRSResponsabilities.Open "[Responsabilities$]", oConn, adOpenStatic, adLockOptimistic
nCols = oRSResponsabilities.RecordCount
If oRSResponsabilities.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSResponsabilities.Close
Exit Sub
Else
nCols = oRSResponsabilities.RecordCount
oRSResponsabilities.MoveFirst
For i = 1 To nCols
If Len(Trim(oRSResponsabilities.Fields("ResponsabilitiesID").Value)) > 0 Then
cadena = Trim(oRSResponsabilities.Fields("ResponsabilitiesID").Value) & " - " & Trim(oRSResponsabilities.Fields("Description").Value)
Combo(2).AddItem cadena
End If
oRSResponsabilities.MoveNext
Next
Combo(2).ListIndex = 0
End If
' ActualizaTxt
'CalculaBonosUS
LimpiaTxt
End Sub
Private Sub ActualizaTxt()
Dim cRes As String, Basic As Currency
Set oRSResponsabilitiesBus = New ADODB.Recordset
'oRSResponsabilitiesBus.Open "[Responsabilities$]", oConn, adOpenStatic, adLockOptimistic
cRes = Left(Combo(2), 2)
oRSResponsabilitiesBus.Open "Select * from [Responsabilities$] Where ResponsabilitiesID = '" & Trim(cRes) & "'", oConn, adOpenStatic, adLockOptimistic
' Carga datos de los salarios
' Set SQLResponsabilitiesBus = cnPpal.Execute("SELECT * FROM Responsabilities Where ResponsabilitiesID = '" & Trim(cRes) & "'", , 1)
If Not oRSResponsabilitiesBus.EOF Then
Txtcampo(0).Text = Format(oRSResponsabilitiesBus.Fields("Basic").Value, "###,##0.00")
Txtcampo(1).Text = Format(oRSResponsabilitiesBus.Fields("Allowance").Value, "###,##0.00")
Txtcampo(2).Text = Format(oRSResponsabilitiesBus.Fields("MonthlySalary").Value, "###,##0.00")
Txtcampo(10).Text = Format(oRSResponsabilitiesBus.Fields("rent").Value, "###,##0.00")
Txtcampo(8).Text = Format(oRSResponsabilitiesBus.Fields("rent").Value * 12, "###,##0.00")
End If
End Sub
Private Sub Combo_Click(Index As Integer)
Select Case Index
Case 0
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 1
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 2
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
' Case 3
' CambiaCombo lctipo1
' Case 6
' ActualizaTxt
' CalculaBonosPS
End Select
End Sub
Private Sub Combo_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
bSalir = False
If vbKeyEscape = KeyCode Then
bSalir = True
Unload Me
End If
' CampoTeclasEsp KeyCode, Shift
End Sub
Private Sub Combo_KeyPress(Index As Integer, KeyAscii As Integer)
If vbKeyEscape = KeyAscii Then
bSalir = True
Unload Me
End If
If vbKeyReturn = KeyAscii Then KeyAscii = 0 ' no importa que digite
End Sub
Private Sub Combo_LostFocus(Index As Integer)
Select Case Index
Case 0
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 1
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
Case 2
' ActualizaTxt
' CalculaBonosUS
LimpiaTxt
' Case 3
' CambiaCombo lctipo1
' Case 6
' ActualizaTxt
' CalculaBonosPS
End Select
End Sub
Public Sub CalculaBonosUS()
Dim cadena As String
Set oRSsQLPorcentajes = New ADODB.Recordset
nBasic = Txtcampo(0).Text
nAllowance = Txtcampo(1).Text
cQualifications = Left(Combo(0), 1)
cExperience = Left(Combo(1), 1)
nMonthly = Txtcampo(2).Text
oRSsQLPorcentajes.Open "Select * from [Escalas$] where EscalaID = '" & Trim(cQualifications) & "'", oConn, adOpenStatic, adLockOptimistic
' Obtiene el calculo del porcentaje
' Set SQLPorcentajes = cnPpal.Execute("SELECT * FROM Porcentajes where PorcentajeID = '" & Trim(cQualifications) & "'", , 1)
If oRSsQLPorcentajes.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
oRSsQLPorcentajes.Close
Exit Sub
Else
nPorcentaje = oRSsQLPorcentajes.Fields("por" & cExperience).Value
' oRSResponsabilitiesBus.Fields("Basic").Value
End If
nCalBonus = (nBasic * nPorcentaje) + nAllowance
nBonoReal = nCalBonus
nSalInt = (Txtcampo(2).Text) * 0.7
nAuxMon = nSalInt * 100 / 70 * 30 / 100
nSueldoSinPlus = nSalInt + nAuxMon
nCalBon = ((nBonoReal - nSueldoSinPlus) * 14 + nBonoReal * 2 + (nBonoReal - nSueldoSinPlus) * 0.12) / 2
' nAnnualGross = Txtcampo(8).Text + Txtcampo(9).Text
Txtcampo(3).Text = Format(nCalBonus, "###,##0.00")
Txtcampo(7).Text = Left(Combo(0), 1) & Left(Combo(1), 1) & Left(Combo(2), 2)
Txtcampo(4).Text = Format(nCalBon, "###,##0.00")
Txtcampo(5).Text = Format(nCalBon, "###,##0.00")
Txtcampo(6).Text = Format(nCalBon * 2, "###,##0.00")
Txtcampo(9).Text = Format((nCalBon * 2) + (nMonthly * 14), "###,##0.00")
nAnualIn = Txtcampo(9).Text
nAnualGross = Txtcampo(8).Text
Txtcampo(11).Text = Format(nAnualIn + nAnualGross, "###,##0.00")
End Sub
Private Sub CambiaCombo(lctipo1 As String)
If Combo(3).ListIndex = 0 Then
' Carga Combo de Responsabilidad Combo 6
Set SQLResponsabilidad = cnPpal.Execute("SELECT * FROM responsabilidades ", , 1)
If SQLResponsabilidad.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
SQLResponsabilidad.Close
Exit Sub
Else
Final = SQLResponsabilidad.RecordCount
Combo(6).Clear
SQLResponsabilidad.MoveFirst
For i = 1 To Final
cadena = Trim(SQLResponsabilidad("ResponsabilidadID")) & " - " & Trim(SQLResponsabilidad("Descripcion"))
Combo(6).AddItem cadena
SQLResponsabilidad.MoveNext
Next
Combo(6).ListIndex = 0
End If
ActualizaTxt
' CalculaBonosUS
Else
' Carga Combo de Responsabilidad Combo 6
Set SQLResponsabilidadNB = cnPpal.Execute("SELECT * FROM responsabilidadesNB ", , 1)
If SQLResponsabilidadNB.EOF Then
MsgBox "Error Grave comuniquese con el administrador del sistema", vbCritical
SQLResponsabilidadNB.Close
Exit Sub
Else
Final = SQLResponsabilidadNB.RecordCount
Combo(6).Clear
SQLResponsabilidadNB.MoveFirst
For i = 1 To Final
cadena = Trim(SQLResponsabilidadNB("ResponsabilidadID")) & " - " & Trim(SQLResponsabilidadNB("Descripcion"))
Combo(6).AddItem cadena
SQLResponsabilidadNB.MoveNext
Next
Combo(6).ListIndex = 0
End If
ActualizaTxt
' CalculaBonosUS
End If
End Sub
Private Sub LimpiaTxt()
Txtcampo(0).Text = Format(0, "###,##0.00")
Txtcampo(2).Text = Format(0, "###,##0.00")
Txtcampo(3).Text = Format(0, "###,##0.00")
Txtcampo(4).Text = Format(0, "###,##0.00")
Txtcampo(5).Text = Format(0, "###,##0.00")
Txtcampo(6).Text = Format(0, "###,##0.00")
Txtcampo(8).Text = Format(0, "###,##0.00")
Txtcampo(9).Text = Format(0, "###,##0.00")
Txtcampo(10).Text = Format(0, "###,##0.00")
Txtcampo(11).Text = Format(0, "###,##0.00")
End Sub
Private Sub Form_Unload(Cancel As Integer)
oRSQualifications.Close
oRSExperience.Close
oRSResponsabilities.Close
' If rDBCursor Is Nothing Then Else rDBCursor.Close
If oRSResponsabilitiesBus Is Nothing Then Else oRSResponsabilitiesBus.Close
If oRSsQLPorcentajes Is Nothing Then Else oRSsQLPorcentajes.Close
End Sub
Valora esta pregunta
0