Fotos en excel con macro, pesa mucho archivo final

Lo que busco es hacer un formulario que me ubique por fotos en una hoja, las imágenes están en una carpeta definida, tengo el siguiente código (lineas abajo), pero, el resultado es un archivo demasiado grande, tanto que cuelga mi maquina, y estoy usando imágenes de 70kB promedio, cargando 6 hojas con 4 fotos por hoja, el archivo pesa más de 20 megas, y el archivo final tendrá cerca de 40 hojas.
Código: (de esta misma página)
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 desconozco su efecto, estoy haciendo pruebas, pero me quise adelantar lanzando la pregunta, si es que alguien puede ayudarme.
Muchas gracias por su tiempo, espero en un futuro poder ayudarlos también con mis experiencias.

1 respuesta

Respuesta
1
Checa este ejemplo y adáptalo
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