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.

2 Respuestas

Respuesta
6

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 Sub


Si 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

  1. Abre tu libro de Excel
  2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
  3. En el menú elige Insertar / Módulo
  4. En el panel del lado derecho copia la macro
  5. Ahora para crear un botón, puedes hacer lo siguiente:
  6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
  7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
  8. 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”
  9. Vuelve a presionar click derecho dentro de la imagen y ahora selecciona: Asignar macro. Selecciona: abririmagen
  10. Aceptar.
  11. Para ejecutarla dale click a la imagen.

Saludos. Dante Amor

No olvides valorar la respuesta.

Respuesta

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.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas