UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1RESUELTO Insertar posición de imagen el 22/03/14, 12:50 pm

Invitado


Invitado
Un saludo, muchachos.
Por mas que lo intento, no logro dos cosas, el codigo en hoja es :

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Union(Target, ["B1:B34"]).Address = ["B1:B34"].Address Then
If Target = "9021" Then
    Range("A1:A34").Select
    ActiveSheet.Pictures.Insert("G:\Fotos Pedidos\9021.jpg").Select
    Selection.ShapeRange.Height = 32.25
    Selection.ShapeRange.Width = 24#
End If
End If
End Sub

Y necesito, no logrando hacerlo es:
G:\Fotos Pedidos\9021.jpg
Que en vez de poner siempre, 9021, pudiera poner cualquier nombre de foto que hubiera en esa carpeta, a su vez que si escribo en  la celda, B25, me salga la foto en la celda A25, osea en la misma linea pero en la columna A.
Pudiendo poner el rango de celdas que necesite, en este momento lo tengo en B1:B34
Aunque no se pueda, gracias de antemano, por las molestias de haberlo leído.
Un saludo
Archivos
FOTO.xls
(21 KB)

2RESUELTO Re: Insertar posición de imagen el 22/03/14, 10:25 pm

tyno


Hola Luis.
Te paso una carpeta que contiene un archivo Excel  y otra carpeta que contiene imágenes. Es un trabajo que hice una vez para alguien que tenía una tienda de música. En el archivo vas a ver un cuadro de lista en la parte superior donde se seleccionan los artistas con los temas y debajo una grilla donde se van cargando los registros que seleccionamos. Pero lo que creo que te va a interesar es que esa grilla donde se cargan los datos uno hace click sobre un registro y aparece una imagen( si es que existe) de la portada del disco seleccionado. 
Dicha carpeta que descargues, una vez descomprimida la vas a ubicar en tu escritorio, luego vas a tener que ir al editor de macros y vas a tener que modificar la ruta de origen de las imagenes porque en el archivo que te paso esta configurado para mi PC:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
Dim rango As Range
Set rango = Range("b15:i60000")
If Union(Target, rango).Address = rango.Address Then
If Target <> "" Then
ActiveSheet.Pictures.Delete
img = Cells(Target.Row, 9)
imagen = "C:\Users\antonio\Desktop\grupos de musica\imagenes\" & img & ".jpg" '<<<<<<<<<modifica RUTA,marcada en rojo
Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
izq = 10 - Target.Column
With etiqueta
    .Left = Target.Offset(0, izq).Left
    .Top = Target.Top
    .Width = 150
    .Height = 150
End With
End If
Else
ActiveSheet.Pictures.Delete
End If
On Error GoTo 0
End Sub

Como veras la ruta hace referencia a la unidad C, mi usuario, la carpeta principal y la carpeta de imagenes y por último el nombre de la imagen mas la extensión jpg. 

Te paso esto a modo de ejemplo para que lo adaptes a tu archivo. 

https://www.dropbox.com/s/tgkhfhlzq445g8x/grupos%20de%20musica.zip

Saludos

3RESUELTO Re: Insertar posición de imagen el 23/03/14, 04:14 am

Invitado


Invitado
Buenos días, tyno, aquí en España, me ha gustado mucho el archivo que me diste, pero no es lo que necesito, lo he guardado, porque algún día lo necesitaré.
En la Hoja2, de tu archivo me gusta como aparece el disco al lado, pero como tengo que poner colores y juego con unas 400 fotos de los modelos, tendría que ser al escribir el modelo que en este caso tendría la foto el mismo nombre
Te mando, un archivo nuevo, explicando lo que necesito y no lo logro.
Un saludo muy fuerte.
Archivos
FOTO2.xls
(69 KB)

4RESUELTO Re: Insertar posición de imagen el 24/03/14, 10:46 am

tyno


Hola Luis.
En el archivo que te había pasado el código que le hice cumplía con tu pedido solo había que adaptar algunas referencias.

Borrá todo el código que tengas en la Hoja 1 y pega estos que son la adaptación del código del archivo anterior:

Private Sub Worksheet_Activate()
'esto limpia la Hoja de las imágenes cuando se selecciona la Hoja
On Error Resume Next
ActiveSheet.Pictures.Delete
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'esto inserta una imagen cuando se ingresa el código de la misma y se da Enter o Tabular
On Error Resume Next
If Union(Target, [D4:D34]).Address =[D4:D34].Address Then
If Target <> "" Then
ActiveSheet.Pictures.Delete
img = Cells(Target.Row, 4)
imagen = "G:\Fotos Pedidos\" & img & ".jpg"
Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
izq = 2 - Target.Column
With etiqueta
    .Left = Target.Offset(0, 2 - Target.Column).Left 'posicion izquierda
    .Top = Target.Top 'posicion altura
    .Width = 100 'ancho imagen
    .Height = 100 'alto imagen
End With
End If
Else
ActiveSheet.Pictures.Delete
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'esto muestra la imagen cuando se selecciona la celda con el código de la misma
On Error Resume Next
If Union(Target, [D4:D34]).Address =[D4:D34].Address Then
If Target <> "" Then
ActiveSheet.Pictures.Delete
img = Cells(Target.Row, 4)
imagen = "G:\Fotos Pedidos\" & img & ".jpg"
Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
izq = 2 - Target.Column
With etiqueta
    .Left = Target.Offset(0, 2 - Target.Column).Left 'posicion izquierda
    .Top = Target.Top 'posicion altura
    .Width = 100 'ancho imagen
    .Height = 100 'alto imagen
End With
End If
Else
ActiveSheet.Pictures.Delete
End If
End Sub


Para ajustar el tamaño y posición de la imagen vas a tener que ir modificando estos datos que verás en los últimos códigos:

With etiqueta
    .Left = Target.Offset(0, 2 - Target.Column).Left 'posición izquierda
    .Top = Target.Top 'posicion altura
    .Width = 100 'ancho imagen
    .Height = 100 'alto imagen
End With


Saludos



Última edición por tyno el 25/03/14, 05:00 pm, editado 1 vez

5RESUELTO Re: Insertar posición de imagen el 24/03/14, 12:42 pm

Invitado


Invitado
Fantástico, eres un hacha.
Solo falta una cosilla, ¿se puede lograr que permanezcan las fotos si escribo varios modelos en el pedido?. Porque me queda solo la foto de la ultima referencia.
Un saludo agradecido

6RESUELTO Re: Insertar posición de imagen el 24/03/14, 01:17 pm

Igtelo


Hola Luis / Tyno, un abrazo.

Luis te dejo un link que tal vez te pueda servir.

http://jldexcelsp.blogspot.mx/2006/09/base-de-datos-de-imgenes-en-excel.html

Saludos
Ignacio Téllez

7RESUELTO Re: Insertar posición de imagen el 24/03/14, 02:03 pm

tyno


Saludos Nacho.
El método que ha utilizado el maestro Jorge Dunkelman sirve también, pero creo que el problema está en el hecho de que si tenemos muchas imágenes el archivo se vuelve muy pesado, por eso, aunque algo más complicado, me parece mejor optar por las macro que insertan imágenes.

Luis: si se pueden dejar las imágenes que se van generando pero tendrías que aumentar el tamaño de las filas (como se ve en el ejemplo que paso Nacho) porque si no te va a quedar todo amontonado. 
Prueba de convertir en texto estas lineas: ActiveSheet.Pictures.Delete , en todos los códigos que te he pasado, o sea agrega delante de la instrucción el apostrofe para que quede el texto de color verde: 'ActiveSheet.Pictures.Delete, también se pueden eliminar esas lineas pero es mejor dejarlas como texto, por las dudas si se necesitan de nuevo el día de mañana. Saludos

8RESUELTO Re: Insertar posición de imagen el 24/03/14, 06:35 pm

Invitado


Invitado
Un saludo muy fuerte, Tyno y Ignacio, gracias a los dos.
Ignacio, ese ejemplo lo he utilizado, pero para otra hoja con reformas, te agradezco el ofrecimiento porque es muy bueno.
Tyno, fabuloso, me has ayudado mucho, lo he logrado terminar, os mando el archivo, para que lo puedan ver todos los usarios, y que lo utilecen cuando lo necesiten.
El problema que me daba, era al borrar todo para generar otro pedido y lo he soluccionado con la macro que he echo.
Si después de revisarlo si podeis, no teneis ninguna observacion en 24 horas lo doy por resuelto
Un abrazote muy fuerte
Archivos
FOTO22.xlsb
(130 KB)

9RESUELTO Re: Insertar posición de imagen el 25/03/14, 01:52 am

Invitado


Invitado
Buenas noches, una ultima pregunta :
Para borrar el contenido, de la hoja Foto22, de un rango estoy usando esta macro.
Sub Borrar_Pedido_FALCATA()
' Macro grabada el 24/03/2014 por Luis
   ActiveSheet.Unprotect Password:="1"
   Range("C7:M102").Select
   Range("C7").Activate
   Selection.ClearContents
   ActiveSheet.Pictures.Delete
End Sub
Pero resulta, que me borra todas las imagenes de la hoja, y necesitaria que me las borrara solamente del rango "C7:M102", estoy queriendo soluccionarlo y no puedo.
Gracias

10RESUELTO Re: Insertar posición de imagen el 25/03/14, 05:08 pm

Invitado


Invitado
Doy el tema por cerrado y resuelto.
Gracias

11RESUELTO Re: Insertar posición de imagen el 25/03/14, 05:15 pm

tyno


Hola Luis, disculpa pero necesito hacer una aclaración.
He corregido algo que deje mal redactado en el código que te he pasado, si bien creo que te funcionaba, de todas formas no estaba bien. 
Lo que he modificado son estas lineas:
  If Union(Target, [D4:D34]).Address =[D4:D34].Address Then anteriormente If Union(Target, ["D4:D34"]).Address  Then.
Ya las he modificado en mi comentario anterior, en todo caso deberías modificarlo en tu código.

Otra cosa es que estaba pensado es que si necesitas modificar alguna imagen ingresando un nuevo código entonces necesitarás este nuevo código:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Union(Target, [D4:D34]).Address = [D4:D34].Address Then
If Target <> "" Then
Application.ScreenUpdating = False
ActiveSheet.Pictures.Delete
For a = 4 To 40
If Cells(a, 4) <> "" Then
img = Cells(a, 4)
imagen = "G:\Fotos Pedidos\" & img & ".jpg"
Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
izq = 2 - Cells(a, 4).Column
With etiqueta
    .Left = Cells(a, 4).Offset(0, 3 - Cells(a, 4).Column).Left 'posicion izquierda
    .Top = Cells(a, 4).Top 'posicion altura
    .Width = 35 'ancho imagen
    .Height = 50 'alto imagen
End With
End If
Next a
Application.ScreenUpdating = True
End If
End If
End Sub

Cuando cambies el código del modelo esta macro si bien elimina todas las imágenes las vuelve a cargar. Esto se ejecuta  una vez ingresado el código del modelo y  se hace Enter o Tabular, de esta manera se reemplaza la imagen que estaba antes.

Saludos

12RESUELTO Re: Insertar posición de imagen el 25/03/14, 05:59 pm

Invitado


Invitado
Fabulosoooooooooooooooooooooooooooooooo, no sabes lo que te le agradezco.
Que Dios te bendiga y a tu casa proteja.
La mejor despedida del tema, la que sale del corazón.
La Paz del Señor este contigo.

13RESUELTO Re: Insertar posición de imagen el 25/03/14, 06:01 pm

Invitado


Invitado
Tema cerrado

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.