Fotos en excel con macro

Lo que busco es hacer un formulario que me coloque "x" fotos en una hoja, las imagenes estan en una carpeta definida, tengo el siguiente codigo (lineas abajo), pero, el resultado es un archivo demasiado grande, tanto que cuelga mi maquina, y estoy usando imagenes de 70kB promedio, cargando 6 hojas con 4 fotos por hoja, el archivo pesa mas de 20 megas, y el archivo final tendra cerca de 40 hojas.
Codigo: (de esta misma pagina)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS As Worksheet
Dim mPath As String
If Not Application.Intersect(Target, [a1]) Is Nothing Then
mPath = "C:\curso\" & Target.Text & ".jpg"
If Dir(mPath) <> "" Then
Set WS = ActiveSheet
WS.OLEObjects("Image1").Object.Picture = LoadPicture(mPath)
End If
End If
If Not Application.Intersect(Target, [a2]) Is Nothing Then
mPath = "C:\curso\" & Target.Text & ".jpg"
If Dir(mPath) <> "" Then
Set WS = ActiveSheet
WS.OLEObjects("Image2").Object.Picture = LoadPicture(mPath)
End If
End If
If Not Application.Intersect(Target, [a3]) Is Nothing Then
mPath = "C:\curso\" & Target.Text & ".jpg"
If Dir(mPath) <> "" Then
Set WS = ActiveSheet
WS.OLEObjects("Image3").Object.Picture = LoadPicture(mPath)
End If
End If
End Sub
he visto otras instrucciones para subir el archivo, pero desconosco su efecto, estoy haciendo pruebas, pero me quise adelantar lanzando la pregunta, si es que alguien puede ayudarme.
Muchas gracias por su tiempo.
Atte,
Victor Montalvo

1 respuesta

Respuesta
1
Checa este ejemplo y adaptalo
Sub InsertaImagen(ByVal Imagen As String)
Dim ws As Worksheet
Dim Path As String
Set ws = ActiveSheet
Path = "C:\Jerry\Pics\PCS\"
Ws. Shapes. AddPicture Path & Imagen, msoTrue, msoFalse, ActiveCell. Left, ActiveCell. Top, ActiveCell. Width, ActiveCell. Height
End Sub
Sub Imagen()
InsertaImagen ActiveCell.Value
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas