Macro en excel en el que pueda abrir una imagen obtener su nombre y guardarla en otra carpeta
Pero necesito un botón que abra un explorador donde pueda seleccionar una imagen, guardar la imagen en otra carpeta, obtener el nombre de la imagen o poder modificarlo.
Esto es para crear un formulario para un inventario, necesito ver la imagen del articulo, tengo este código
'documento = Application.GetOpenFilename("Imagenes (*.jpg*), *.jpg*")
'Cells(1, 1) = documento
Me da la dirección de la imagen, el problema es que si quiero mover mi documento a otro equipo, las rutas de las imágenes quedarían invalidas.
Alguien podría ayudarme, o podría sugerirme otra idea.
Hola Dante Amor, vi tu código para abrir una imagen y luego moverla de lugar.
Como haría para una vez que yo elija una imagen para abrir, me permita insertarla en una hoja de excel y extraer su nombre y/o ruta. Para poder luego insertarla en un registro de una base de datos.
1 respuesta más de otro experto
Te anexo la macro con lo siguiente.
1. Cuando ejecutas la macro, te abre el explorador.
2. Una vez abierto el explorador, puedes realizar lo siguiente:
3. Para ver la imagen: Selecciona un archivo, ahora presiona el botón de "Vistas" y selecciona la opción "Vista previa". De esta forma podrás ver las imágenes.
4. Para modificar el nombre de la imagen: Selecciona el archivo. Ahora presiona la tecla "F2" para editar el nombre.
5. Para mover el archivo a otra carpeta. Selecciona el archivo, presiona el botón "Abrir". La macro te preguntará "Quieres mover el archivo", si presionas "No" la macro termina;
Si presionas "Sí"; la macro te presenta el explorador, pero de carpetas. Selecciona la carpeta destino para mover el archivo y presiona "Aceptar"
Listo, el archivo con la imagen se moverá a la carpeta que hayas elegido.
Te dejo la macro para mover imágenes.
Sub abririmagen()
'Por.Dante Amor
imag = Application.GetOpenFilename(FileFilter:= _
"Imágenes (*.gif;*.jpg;*.jpeg;*.bmp; *.png), *.gif;*.jpg;*.jpeg;*.bmp; *.png", _
Title:="Selecciona una imagen", MultiSelect:=False)
If imag <> False Then
arch = LTrim(Mid(imag, 1 + InStrRev(imag, "\")))
If MsgBox("Quieres mover el archivo", vbYesNo) = vbYes Then
ruta = ThisWorkbook.Path
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Selecciona la carpeta destino"
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
On Error GoTo sincopia
FileCopy imag, cp & "\" & arch
Kill imag
MsgBox "El Archivo se cambió de carpeta"
End If
End If
End
sincopia:
MsgBox "El archivo no se pudo mover"
End SubSi no quieres que el archivo origen se borre, entonces quita de la macro esta línea:
Kill imag
Entonces solamente se copiará el archivo.
Sigue las Instrucciones para un botón y ejecutar la macro
- Abre tu libro de Excel
- Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
- En el menú elige Insertar / Módulo
- En el panel del lado derecho copia la macro
- Ahora para crear un botón, puedes hacer lo siguiente:
- Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
- Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
- Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona: Tamaño y Propiedades. En la ventana que se abre selecciona la pestaña: Propiedades. Desmarca la opción “Imprimir Objeto”. Presiona “Cerrar”
- Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: abririmagen
- Aceptar.
- Para ejecutarla dale click a la imagen.
Saludos. Dante Amor
No olvides valorar la respuesta.