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
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 de jerryeagle
1