Forums Últimos mensajes - Powered by IBM
 
Tags Palabras claves

Se dañó el código

10/10/2007 - 13:43 por GRIEGO59 | Informe spam
Tengo un código espectacular que me suministró Hector Miguel en este foro.
Funcionaba muy bien hasta que yo agregué las columnas J,K,L,M,N,O,P,Q.

Cuando intruduzco un serial inexistente me da:
Error 13 en tiempo de ejecución, no coinciden los tipos.

Estuve revisando el código para intentar *ampliar el rango?* pero, la
verdad, no consegí ese rango.

El código que tengo es el siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub

Actualmente el código hace cuatro cosas
1- al escribir en un número de cédula de cliente inexistente en la hoja
"clientes" abre mensaje y pregunta si desea crearlo, y abre formulario para
crearlo.
2- al escribir un serial ya escrito en la hoja actual (hoja "facturadeventa)
abre mensaje y evita el registro.
3- al escribir un serial vendido (según hoja "compras") abre mensaje y evita
el registro.
4- al escribir un serial inexistente (según hoja "compras") abre mensaje de
aviso, y evita el registro. Es aquí donde me da el error al introducir un
serial inexistente.

Información adicional:
Hoja "facturadeventas"
E2 múmero de cédula cliente
C2 Fórmula VBuscar nombre del cliente en hoja "clientes"
B4:B18 seriales vendidos en esa factura
C4:C18 Fórmula Vbuscar descripción del producto en hoja "compras"

Hoja "clientes"
A1 Título Número de cédula cliente
A2 título Nombre cliente

Hoja "compras"
A1 Título Serial del producto
D1 Título Descripción del producto
G1 Título Fecha de venta
H1 Título Número de factura de venta
I1 Título Precio de venta final

Espero que puedan ayudarme por favor y disculpen lo seguido.

Griego59
 

Leer las respuestas

#1 Héctor Miguel
11/10/2007 - 01:07 | Informe spam
hola, Darío !

en el codigo (y la consulta) original no esta contemplada la posibilidad de introducir seriales inexistentes en la factura
(ademas de que no comentas a cual hoja le agregaste columnas, ni cual es el objetivo de las mismas)
y el error se debe a que la funcion (VLookup) obviamente no podra encontrar un codigo que no existe en la hoja "compras"

prueba modificando el codigo a partir de la etiqueta de los Seriales:
de:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents

a:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
With Worksheets("compras")
If Application.CountIf(.[a:a], Target) Then
If Application.VLookup(Target, .[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
Else
Msj = " no es un serial existente !!!"
End If
End With
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

__ la consulta original __
Tengo un codigo... que... Funcionaba muy bien hasta que yo agregue las columnas J,K,L,M,N,O,P,Q.
Cuando intruduzco un serial inexistente me da: Error 13 en tiempo de ejecucion, no coinciden los tipos.
Estuve revisando el codigo para intentar *ampliar el rango?* pero, la verdad, no consegi ese rango (...)
Actualmente el codigo hace cuatro cosas
1- al escribir en un numero de cedula de cliente inexistente en la hoja "clientes"
abre mensaje y pregunta si desea crearlo, y abre formulario para crearlo.
2- al escribir un serial ya escrito en la hoja actual (hoja "facturadeventa) abre mensaje y evita el registro.
3- al escribir un serial vendido (segun hoja "compras") abre mensaje y evita el registro.
4- al escribir un serial inexistente (segun hoja "compras") abre mensaje de aviso, y evita el registro.
Es aqui donde me da el error al introducir un serial inexistente.
Informacion adicional:

Hoja "facturadeventas"
E2 mumero de cedula cliente
C2 Formula VBuscar nombre del cliente en hoja "clientes"
B4:B18 seriales vendidos en esa factura
C4:C18 Formula Vbuscar descripcion del producto en hoja "compras"

Hoja "clientes"
A1 Titulo Numero de cedula cliente
A2 titulo Nombre cliente

Hoja "compras"
A1 Titulo Serial del producto
D1 Titulo Descripcion del producto
G1 Titulo Fecha de venta
H1 Titulo Numero de factura de venta
I1 Titulo Precio de venta final



__ el codigo expuesto __
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Msj As String
If Intersect(Target, Range("e2,b4:b18")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Worksheets("clientes")
If Target.Address <> "$E$2" Then GoTo Seriales
If Not Evaluate("iserror(c2)") Then Exit Sub
If MsgBox("El codigo solicitado: " & Target & " NO existe..." & vbCr & _
"Confirmas que debe darse de alta ?", vbYesNo, _
"Alta de clientes...") = vbNo Then Exit Sub
SendKeys "{down " & Application.CountA(.[a:a]) - 1 & "}" & Target & "{tab}"
.ShowDataForm
.[a:b].Sort Key1:=.[a2], Order1:=xlAscending, Header:=xlYes
Target.Select
Exit Sub
End With
Seriales:
If Application.CountIf([b4:b18], Target) > 1 Then Msj = " esta duplicado !!!"
If Application.VLookup(Target, Worksheets("compras").[a:g], 7, 0) > 0 _
Then Msj = " es un producto YA facturado !!!"
If Msj <> "" Then MsgBox "El serial " & Target & Msj: Target.ClearContents
End Sub

Preguntas similares