Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Fabiola

Excel - Fabiola

Volver
Nuevo Tema
<<>>
 
Vista:

Fabiola

Publicado por MACRO QUE INSERTE EN A1 UNA FOTO Y EN B1 EL NOMBRE DEL JPG (1 intervención) el 04/03/2019 21:43:01
Hola,
Quiero crear una macro para Excel que me coloque todas las fotos que tengo guardadas en una carpeta en una columna (todas del mismo tamaño:1,8cm de alto y centradas en la celda), y en la columna de al lado me coloque el nombre de cada foto.
Alguien me puede ayudar?

Gracias y saludos!!
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
Imágen de perfil de Antoni Masana
Val: 4.908
Oro
Ha mantenido su posición en Excel (en relación al último mes)
Gráfica de Excel

MACRO QUE INSERTE EN A1 UNA FOTO Y EN B1 EL NOMBRE DEL JPG

Publicado por Antoni Masana (2477 intervenciones) el 06/03/2019 21:17:49
Primero necesitas un contador para saber a que celda poner la imagen y un bucle que las lea

1
2
3
4
5
6
7
8
9
10
11
12
Sub Poner_Imagen()
    Dim Celda_Alto As Single, Celda_Anch As Single, Fila as Integer, Fichero as String, _
        Celda_Supe As Single, Celda_Izqu As Single
 
    Fila = 0
    Fichero =  Dir("C:\Directorio\*.jpg")
    While Fichero <> ""
        ...
        Cells(Fila, "B") = Fichero
        Fichero = Dir()
    Wend
End Sub

Esto básicamente lee la lista de ficheros y pone los nombres en la columna B

A partir de aquí hay el código que ha de ir donde los puntos suspensivos.
Pero primero tienes que definir el alto y ancho de las celdas de la columna A para que entre las fotos al tamaño deseado

Leer la imagen, Darle Tamaño

1
ActiveSheet.Pictures.Insert(Fichero).Select

Averiguar la posición de la celda:

1
2
3
4
Celda_Supe = Cells(Fila, "A").Top
Celda_Izqu = Cells(Fila, "A").Left
Celda_Alto = Cells(Fila, "A").Height
Celda_Anch = Cells(Fila, "A").Width

Y posicionar la imagen en la Celda y darle Tamaño

1
2
3
4
Selection.ShapeRange.Top = Celda_Supe
Selection.ShapeRange.Left = Celda_Izqu
Selection.ShapeRange.Height = Celda_Alto
Selection.ShapeRange.Width = Celda_Anch


Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar