Visual Basic para Aplicaciones - Visual Basic y Excel

Life is soft - evento anual de software empresarial
 
Vista:

Visual Basic y Excel

Publicado por Omar Leonardo Gil (1 intervención) el 19/12/2011 04:14:51
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

Error 430 en programas de Visual Basic 6.0
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder