Visual Basic - Se ha producido el error en tiempo de ejecucion no

Life is soft - evento anual de software empresarial
 
Vista:

Se ha producido el error en tiempo de ejecucion no

Publicado por Wilfredo (1 intervención) el 08/07/2010 15:24:21
Buenos días me ha ocurrido un error en este programa en mi maquina se ejecuta bien pero en la computadora de otro usuario no funciona bien ya he revisado las refenrencias y estan iguales, de ante mano les agradesco la colaboración.

Option Compare Database

Private Sub cboProducto_AfterUpdate()
Dim strCriterio As String
Dim nCosto As Double
strCriterio = "Select * FROM Productos where IdProducto=" & cboProducto
Me.RecordSource = strCriterio
Call CalculaSub1
Call CalculaSub2
Call CalculaSub6
Call CalculaSub7
Call CalculaSub3

Me.TxtSumSubT = Me.TxtSub1 + Me.TxtSub2 + Me.TxtSub3 + Me.TxtSub4 + Me.TxtSub5 + Me.TxtSub6 + Me.TxtSub7 (En esta linea es donde me indica el error)

Forms![CUPr]![TxtSumSubT] = Forms![CUPr]![TxtSub1] + Forms![CUPr]![TxtSub2] + _
Forms![CUPr]![TxtSub31] + Forms![CUPr]![TxtSub4] + _
Forms![CUPr]![TxtSub5] + Forms![CUPr]![TxtSub6] + Forms![CUPr]![TxtSub7]

nCosto = Round(Me.TxtSumSubT, 0)
'nCosto = -1 * (Int(-1 * nCosto)) 'Redondeo hacia arriba

Call actProd(nCosto)

End Sub
Private Sub Form_Open(Cancel As Integer)
Dim rTasa
Set rTasa = CurrentDb.OpenRecordset("TasaCambio")
Me.TxtTasa = rTasa!Tasa
End Sub

Private Sub CalculaSub1()

Dim nSubTot1 As Double 'Total costos por Componentes

Dim rPr
Dim rCo
Dim CoPr

Set rPr = CurrentDb.OpenRecordset("Productos")
rPr.Index = "primarykey" 'IdProducto

Set rCo = CurrentDb.OpenRecordset("Componentes")
rCo.Index = "primarykey" 'IdComponente

Set rCoPr = CurrentDb.OpenRecordset("ComponentesProducto")
rCoPr.Index = "kIdProducto"

rCoPr.Seek "=", CLng(Me.IdProducto)
If Not (rCoPr.nomatch) Then
Do Until rCoPr.EOF
If rCoPr!IdProducto = CLng(Me.IdProducto) Then
rCo.Seek "=", rCoPr!IdComponente
If Not (rCo.nomatch) And Not (IsNull(rCo!CostoUnitario)) Then
nSubTot1 = nSubTot1 + rCoPr!Cantidad * rCo!CostoUnitario
End If
Else
Exit Do
End If
rCoPr.MoveNext
Loop
End If
Me.TxtSub1 = nSubTot1

End Sub

Public Sub CalculaSub2()
'Calculo de Costos de Accesorios.
Dim nSubTot2 As Double 'Total costos por Empaque

Dim rEmPr
Dim rEmp
Dim rTasa

Set rEmPr = CurrentDb.OpenRecordset("EmpaquesProducto")
rEmPr.Index = "primarykey" 'IdProducto+Idempaque

Set rEmp = CurrentDb.OpenRecordset("Empaques")
rEmp.Index = "primarykey" 'IdEmpaque

Set rTasa = CurrentDb.OpenRecordset("TasaCambio")

rEmPr.Seek "=", CLng(Forms!CUPr!cboProducto)
Do Until rEmPr.EOF
If rEmPr!IdProducto = CLng(Me.cboProducto) Then
rEmp.Seek "=", rEmPr!IdEmpaque
If Not (rEmp.nomatch) Then
If rEmp!UnMed = "Kg" Then
nSubTot2 = nSubTot2 + rEmPr!Cantidad * rEmp!Costo / 1000
Else
nSubTot2 = nSubTot2 + rEmPr!Cantidad * rEmp!Costo
End If
End If
Else
Exit Do
End If
rEmPr.MoveNext
Loop
Me.TxtSub2 = nSubTot2 * rTasa!Tasa
End Sub

Public Sub CalculaSub6()
Dim rPPE
Dim rMO
Dim nSumCosto As Double

Set rMO = CurrentDb.OpenRecordset("ManoDeObra")
rMO.Index = "primarykey"

Set rPPE = CurrentDb.OpenRecordset("ProdProcEmpq")
rPPE.Index = "Idproducto"

rMO.Seek "=", 1
If Not (rMO.nomatch) Then
rPPE.Seek "=", CLng(Forms!CUPr!cboProducto)
Do Until rPPE.EOF
If rPPE!IdProducto = CLng(Forms!CUPr!cboProducto) Then
If rPPE!Rendimiento > 0 Then
If rPPE!IdProceso = 3 Then ' Horno termo Encogible
nSumCosto = nSumCosto + (rPPE!MO * rMO!FactorCosto / rPPE!Rendimiento) _
+ (rPPE!MO * rMO!FactorCosto * rPPE!Montaje / Forms!CUPr!TxtCantidad)
Else
nSumCosto = nSumCosto + (rPPE!MO * rMO!FactorCosto / rPPE!Rendimiento)
End If
End If
rPPE.MoveNext
Else
Exit Do
End If
Loop
End If
Forms!CUPr!TxtSub6 = nSumCosto
End Sub

Public Sub CalculaSub7()
Forms!CUPr!TxtSub7 = Forms!CUPr.Form!DetCUPrFijos!TxtTotal
End Sub

Public Sub CalculaSub3()

Dim nSumCosto As Double 'Costo total de Accesorios
Dim rAcc
Dim rAccPr

Set rAcc = CurrentDb.OpenRecordset("Accesorios")
rAcc.Index = "primaryKey"

Set rAccPr = CurrentDb.OpenRecordset("Accesoriosproducto")
rAccPr.Index = "kIdProducto"

nSumCosto = 0

rAccPr.Seek "=", CLng(Forms!CUPr!cboProducto)
If Not (rAccPr.nomatch) Then
Do Until rAccPr.EOF
If rAccPr!IdProducto = CLng(Forms!CUPr!cboProducto) Then
rAcc.Seek "=", rAccPr!IdAccesorio
If Not (rAcc.nomatch) Then
If rAccPr!IdProducto = CLng(Forms!CUPr!cboProducto) And _
rAcc!IdAccesorio = rAccPr!IdAccesorio Then
nSumCosto = nSumCosto + rAccPr!Cantidad * rAcc!CostoUnitario
End If
End If
Else
Exit Do
End If
rAccPr.MoveNext
Loop
End If
Me.TxtSub31 = nSumCosto

End Sub

Private Sub actProd(nCosto)

Dim rPr
Set rPr = CurrentDb.OpenRecordset("Productos")
rPr.Index = "primarykey" 'IdProducto

rPr.Seek "=", Me.cboProducto
If Not (rPr.nomatch) Then
rPr.Edit
rPr.Costo = nCosto
rPr.Update
End If

End Sub
Private Sub btnImprimir_Click()
On Error GoTo Err_btnImprimir_Click

Dim stDocName As String
Dim strCriterio As String

strCriterio = "SELECT * FROM Productos WHERE IdProducto = " & Me!cboProducto

stDocName = "Informe CUPr"
DoCmd.OpenReport stDocName, acNormal, , wherecondition:="IdProducto = " & "[Forms]![CUPr]![IdProducto]"

'DoCmd.OpenReport stDocName, acPreview

Exit_btnImprimir_Click:
Exit Sub

Err_btnImprimir_Click:
MsgBox Err.Description
Resume Exit_btnImprimir_Click
End Sub
Private Sub btnCerrar_Click()
On Error GoTo Err_btnCerrar_Click

DoCmd.Close
Exit_btnCerrar_Click:
Exit Sub
Err_btnCerrar_Click:
MsgBox Err.Description
Resume Exit_btnCerrar_Click

End Sub
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