Vincular imagen desde archivo con macro
Escribo desde San Salvador, El Salvador y tengo la siguiente macro
Sub misfotos() 'solo para celda activa
tope = ActiveCell.Top
izq = ActiveCell.Left
alto = ActiveCell.Height
ancho = ActiveCell.Width
'se inserta y selecciona la imagen
On Error GoTo salgo
miFoto = Application.Dialogs(xlDialogInsertPicture).Show
'If miFoto <> False Then 'si no se canceló la ventana
ActiveSheet.Pictures.Insert(miFoto).Select
'ActiveSheet.Shapes(miFoto).Select
'se ajustan las dimensiones de la imagen insertada
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
'Selection.ShapeRange.LockAspectRatio = msoFalse 'NO mantiene proporción
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
End If
salgo:
End Sub
Lo que necesito es que, en ves de insertarse la imagen en el archivo, esta se vincule, dicho de otra manera necesito que las imágenes se puedan vincular desde una carpeta por, con el fin de no cargar en archivo de excel o corromper el mismo por la cantidad de imágenes que este contendrá...
Sub misfotos() 'solo para celda activa
tope = ActiveCell.Top
izq = ActiveCell.Left
alto = ActiveCell.Height
ancho = ActiveCell.Width
'se inserta y selecciona la imagen
On Error GoTo salgo
miFoto = Application.Dialogs(xlDialogInsertPicture).Show
'If miFoto <> False Then 'si no se canceló la ventana
ActiveSheet.Pictures.Insert(miFoto).Select
'ActiveSheet.Shapes(miFoto).Select
'se ajustan las dimensiones de la imagen insertada
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
'Selection.ShapeRange.LockAspectRatio = msoFalse 'NO mantiene proporción
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
End If
salgo:
End Sub
Lo que necesito es que, en ves de insertarse la imagen en el archivo, esta se vincule, dicho de otra manera necesito que las imágenes se puedan vincular desde una carpeta por, con el fin de no cargar en archivo de excel o corromper el mismo por la cantidad de imágenes que este contendrá...
1 Respuesta
Respuesta de blooddragon
1
sutituye ActiveSheet.Pictures.Insert(miFoto).Select por el siguiente
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"C:\JM\01\Imagenes\21blackJack.jpg" --> aqui variable con el path
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
"C:\JM\01\Imagenes\21blackJack.jpg" --> aqui variable con el path
Muchas gracias por tu pronta respuesta, he probado tu sugerencia y funciona, pero creo que no me explique bien, la macro actualmente abre la caja de dialogo con la instrucción Application.Dialogs(xlDialogInsertPicture). Show para buscar y poder elegir una imagen a insertar, esta a su ves se acopla al tamaño de la celda.
Lo que quiero es cambiar el insertar por el vincular a archivo, visualizando de la misma manera la imagen acoplada en la celda activa, al haber elegido cualquier imagen de varias carpetas que están en un mismo sitio.
Lo que quiero es cambiar el insertar por el vincular a archivo, visualizando de la misma manera la imagen acoplada en la celda activa, al haber elegido cualquier imagen de varias carpetas que están en un mismo sitio.
¿Has probado con las api de windows?
'------------------------------------------------------------------------------
'Declaraciones del Api
'------------------------------------------------------------------------------
'Esta función busca el primer archivo de un Dir
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
'Esta el siguiente archivo o directorio
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _
ByVal lpFileName As String) As Long
'Esta cierra el Handle de búsqueda
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
'------------------------------------------------------------------------------
'Declaraciones del Api
'------------------------------------------------------------------------------
'Esta función busca el primer archivo de un Dir
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
'Esta el siguiente archivo o directorio
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" ( _
ByVal lpFileName As String) As Long
'Esta cierra el Handle de búsqueda
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
