Macro para traer imágenes a una hoja

Solo consultas sobre macros y código VBA Excel.
Reglas del Foro
1. Antes de hacer tu pregunta intenta con el buscador de este foro (muchas preguntas ya fueron respondidas antes!)
2. Si haces una nueva pregunta, es muy recomendable que adjuntes el ejemplo Excel para poder comprenderla mejor!
3. Realiza tu pregunta de forma clara, explicando bien cada paso de lo que haces y tendrás más probabilidad de respuesta!
Responder
NastyMind
Miembro Nuevo
Miembro Nuevo
Mensajes: 3
Registrado: 13 Jun 2019 19:08

Macro para traer imágenes a una hoja

Mensaje por NastyMind » 13 Jun 2019 19:17

Tengo una macro para pegar una imagen en una ficha de acuerdo al nombre que hay en una celda. Actualmente me funciona si esta macro la tengo en un modulo y la asigno a un botón, pero quiero que esta imagen me salga automáticamente si yo selecciono un articulo desde una hoja. Agregue el código en la hoja para que se ejecute pero me da un error 1004 y ya no se que hacer. He buscado en varias paginas y nada que doy con la solución del problema.

En resumen, en un hoja tengo una tabla con articulos, al seleccionar uno de los articulos, se abre en otra hoja, todo el detalle que compone ese articulo (hasta esa parte el código me funciona perfecto) adicionalmente quiero que venga una imagen relacionada a ese articulo y se pegue en la celda que le asigno (ahí es donde me salta el error)

Código: Seleccionar todo

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim CeldaActual As String
    Dim h1 As Object
    Dim h2 As Object
    Dim h3 As Object
    Dim clave As String
    Dim col As String
    Dim i As Integer
    Dim Pic As Object
    Dim carpeta As String
    Dim imagen As String
    
    CeldaActual = ActiveCell.Row
    If Not Intersect(Target, Range("C9:I308")) Is Nothing Then
    
    'Buscar información
    Application.ScreenUpdating = False
    Set h1 = Sheets("Visualizar información")
    Set h2 = Sheets("Ficha del Activo Fijo")
    Set h3 = Sheets("Inventario")
    h2.Range("D3:D20,M3").ClearContents

    
    'VALIDACIONES
    clave = h1.Cells(CeldaActual, 27).Value       'Cod del Activo Fijo
    If clave = "" Then
        MsgBox "No se puede visualizar por falta de código de activo", vbCritical
        Exit Sub
    End If
    
    'COPIA INFORMACIÓN
    If h3.AutoFilterMode Then h3.AutoFilterMode = False
        col = 1
        For i = 4 To h3.Range("D" & Rows.Count).End(xlUp).Row
            If h3.Cells(i, 4).Value = clave Then
                h2.Cells(3, "D").Value = h3.Cells(i, "E").Value
                h2.Cells(5, "D").Value = h3.Cells(i, "F").Value
                h2.Cells(6, "D").Value = h3.Cells(i, "G").Value
                h2.Cells(7, "D").Value = h3.Cells(i, "H").Value
                h2.Cells(8, "D").Value = h3.Cells(i, "I").Value
                h2.Cells(9, "D").Value = h3.Cells(i, "J").Value
                h2.Cells(10, "D").Value = h3.Cells(i, "K").Value
                h2.Cells(11, "D").Value = h3.Cells(i, "L").Value
                h2.Cells(12, "D").Value = h3.Cells(i, "M").Value
                h2.Cells(13, "D").Value = h3.Cells(i, "N").Value
                h2.Cells(14, "D").Value = h3.Cells(i, "O").Value
                h2.Cells(15, "D").Value = h3.Cells(i, "Q").Value
                h2.Cells(16, "D").Value = h3.Cells(i, "R").Value
                h2.Cells(17, "D").Value = h3.Cells(i, "S").Value
                h2.Cells(3, "M").Value = h3.Cells(i, "P").Value
            End If
        Next
    End If    'DESPUES DE AQUI COMIENZAN A SALIR LOS ERRORES
    h2.Select
        For Each Pic In ActiveSheet.Pictures
            Pic.Delete
        Next Pic
    'tomamos el nombre de la celda M3 y colocamos foto
    carpeta = "D:\Usuarios\dvelasquez\Desktop\Expediente\"
    'el nombre de la foto deberá estar en alguna celda
    imagen = Range("M3")
    'Celda donde se va a poner la foto
    Range("K7").Select
    ActiveSheet.Pictures.Insert(carpeta & imagen & ".jpg").Select
    With Selection
    .Placement = xlMoveAndSize
    .PrintObject = True
    End With
    Selection.ShapeRange.LockAspectRatio = msoFalse
    'modificar las siguientes medidas para ajustar el tamaño de la foto
    Selection.ShapeRange.Height = 220#
    Selection.ShapeRange.Width = 320#
    Selection.ShapeRange.Rotation = 0#
    Application.ScreenUpdating = True
    MsgBox "Visualizar ficha seleccionada"
End Sub



Responder