INSERTAR UNA MACRO A UN CAMPO DE UN ARCHIVO

[Oscar Arroyave]

Buenos dias al foro,

Tengo una inquietud, ojala me pudieran ayudar a resolverla:

1. Tengo un archivo con varias hojas

2. En cada hoja hay un formato, en el cual esta el campo Cliente (Columna  "D")

3. En este momento esta programado para cuando uno se posicione en dicho campo vaya a una Hoja y consulte si existe el cliente o no, si existe colca su nombre e identificación, si no, Coloca No existe y no mas.

4.. Deseo que cuando me posicione en el campo o celda nombre me ejecute la macro que adjunto, o sea,  que consulte si existe o no el cliente

• Si existe que me copie la identificación y el nombre del cliente
• Si no existe crearlo.

4. Adjunto los archivos para ver como se realiza esta unificación, ya que no he sido capaz.

 

Les agradeceria su colaboración

8. Planilla Diaria-Agosto-Prueba.xlsm

Formulario_Avanzado Clientes.xlsm

[AGUSTINGT8]

Buenas tardes Oscar

Realiza los siguinetes cambios en tu archivo:

inserte el siguiente codigo en un modulo

Sub BuscDatos()
datobuscar = ActiveCell.FormulaR1C1
If datobuscar = "" Then
MsgBox "Coloca algun dato para buscar", vbOKOnly + vbInformation, ""
Exit Sub
End If
Set rango = Sheets("Px").Range("B:B").Find(What:=datobuscar, _
LookAt:=xlWhole, LookIn:=xlValues)
ActiveCell.Offset(0, -1).Select

If rango Is Nothing Then
ActiveCell.FormulaR1C1 = "Nombre no Encontrado"
MsgBox "Nombre no Encontrado"
Exit Sub
Else
ActiveCell.FormulaR1C1 = Sheets("Px").Range("A" & rango.Row)
MsgBox "Dato verificado"
End If
End Sub

Es necesario modificar tu codigo en la instruccion "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" cambiando  Cap_Pacientes.Show  por BuscDatos, solo la primera linea el resto queda igual.

If Not Intersect(Target, Range("D14:D38,D43:D67,D72:D96,D101:D125,D130:D154,D159:D183")) Is Nothing Then BuscDatos 

realiza los cambios y me comentas, Saludos

AGUSTIN GARCIA

[Oscar Arroyave]

Agustin, buenas tardes, que pena, es que no me encontraba en la ciudad, vi tu respuesta, en la tarde la pondre en practica y te diré si me funciono.

 

Muchas gracias.

[Oscar Arroyave]

Agustin, buenas tardes,

Realice los ajustes que me indicaste y si, la sub-rutina de buscar hace lo que dice, pero la idea es otra, como indique en el correo anterior, es decir:

1. En el campo "Cliente", debo llamar la rutina que adjunte en el archivo "Formulario_Avanzado Clientes", esto es que cuando el cursor este en la celda uno pueda digitar el nombre del Cliente y si existe traer los campos de identificación y nombre que estan en la base de datos, sino existe que de la opción de crearlo.

2. No soy experto en excel, es que llevo el archivo poco a poco y esa rutina la debo pegar a lo que yo tengo hecho.

 

Espero que me entiendas y disculpa.

Muchas Gracias

 

 

[AGUSTINGT8]

Solo para ir aclarando a que nos referimos.

El campo ""clientes" te estas refiriendo  la hoja "clientes" ?

Cuando te refieres a base de datos es la hoja "px"?

Si eso es correcto prueba con este codigo que lo debes de pegar en un modulo en el archivo ""Formulario_Avanzado Clientes"

Sub BuscDatos()
datobuscar = ActiveCell.FormulaR1C1
If datobuscar = "" Then
MsgBox "Coloca algun dato para buscar", vbOKOnly + vbInformation, ""
Exit Sub
End If
Set rango = Workbooks("8. Planilla Diaria-Agosto-Prueba.xlsm").Sheets("Px").Range("B:B").Find(What:=datobuscar, _
LookAt:=xlWhole, LookIn:=xlValues)

If rango Is Nothing Then
MsgBox "Nombre no Encontrado"
Exit Sub
Else

'Direccion
ActiveCell.Offset(0, 1) = Workbooks("8. Planilla Diaria-Agosto-Prueba.xlsm").Sheets("Px").Range("L" & rango.Row)
'Telefono
ActiveCell.Offset(0, 1) = Workbooks("8. Planilla Diaria-Agosto-Prueba.xlsm").Sheets("Px").Range("J" & rango.Row)
'email
ActiveCell.Offset(0, 2) = Workbooks("8. Planilla Diaria-Agosto-Prueba.xlsm").Sheets("Px").Range("k" & rango.Row)

ActiveCell.Offset(1, -4).Select
MsgBox "Datos encontrados"

End If
End Sub

Y el siguiente codigo ver en la imagen que se adjunta, para ver donde va

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(Target, Range("A:A")) Is Nothing Then
  Exit Sub
 Else
    Call BuscDatos
 End If
End Sub

Esto lo que hacce es que al darle doble clic en la celda donde ingresaste el nombre del cliente ejecuta la instruccion "BuscarDatos" y si lo encuntra trae los datos.

 

Espero que te sea de ayuda.

 

 

 

[Oscar Arroyave]

Buenas tardes Agustin, que pena con usted, de pronto me a faltado claridad, y es bueno que hablemos del mismo tema, ya que usted e el que me puede ayudar, gracias de antemano.

Ocurre lo siguiente:

1. Envie dos archivos

• El primero es un resumen, donde estan todos los campos en cada columna, es decir, en el archivo "Planilla Diaria-Agosto" hay varias hojas, en el ejemplo "3", dentro de esta, hay un campo que se llama "paciente"
• Lo que deseo es que cuando me posicione en dicha celda, me tome la Macro o el procedimiento que adjunte llamado "Formulario Avanzado de Clientes", o sea, que me pida el nombre del cliente y si existe que me coloque la identificación y el nombre, si no existe, debe traer el formulario para llenar los datos y quede creado en la Base de datos.
• En el archivo que te envie hay una Base de Datos "Px", pero yo la quiero sacar del archivo, quiero que quede independiente.
• No se si esa Base de datos me sirve para el archivo que te envie de "Formulario Avanzado de Clientes"

Disculpa molestarte, peo si soy claro en este caso?

O si hay otra forma de hacerlo mejos y menos complicado te agradecería, o sea, es llamar a una base de datos el Paciente, si existe colocar identificación y nombre, de lo contrario, traer un formulario que me permita crearlo.

 

Gracias y disculpa nuevamente.

 

[Oscar Arroyave]

Agustin, buenas tardes

Adjunto el archivo con las macros que me recomendaste, mira su funcionamiento, ya que a mi no me hicieron lo que pretendía, o lo hice mal?

Gracias por tu ayuda nuevamente.

 

8. Planilla Diaria-Agosto-Prueba.rar

Formulario_Avanzado Clientes.xlsm

[Oscar Arroyave]

Agustin, buenos días

Quisiera saber si lo que te copie si esta claro, para saber como procedo.

Disculpa molestarte

[AGUSTINGT8]

Buenos días Oscar:

Perdon por no responder antes, ya que por razones de trabajo no me quedo tiempo conectarme, pero ya estamos para retomar el tema, voy a revisar el archivo que adjuntas, saludos

[Oscar Arroyave]

Gracias Agustín por responderme, ojala me dieras la oportunidad de enviarte lo que he hecho, pero no tengo los cocimientos suficientes para completar todo lo que quiero hacer, no se si es lo mejor, pero lo que he realizado es con la ayuda de ustedes y con q estudiado.

Los archivos son muy pesados, por eso no te los puedo enviar por esta plataforma, pero con lo que te envié me ayuda a completar lo que quiero.

Gracias y disculpa por molestarte

 

[Oscar Arroyave]

Agustin, que pena molestarlo, pero me puede decir como va con el tema, es que no me funciona todavia.

Gracias