Me sale error en colocar la imagen adjunto foto

Y necesito la imagen que este acá mira la segunda foto que adjnto, que ocupe lo ancho y largo del margen

1 Respuesta

Respuesta
2

Hay que cargar nuevamente la imagen.

Para eso vamos a almacenar la ruta y el nombre del archivo en la columna Q al momento de guardar los datos:

 'poner foto
    arch = Label19.Caption
    If arch <> "" Then
        If Dir(arch) <> "" Then
            Set fotografia = h.Pictures.Insert(ruta & arch)
            '
            With fotografia
                '.Name = "foto de la imagen"
                .ShapeRange.LockAspectRatio = msoFalse
                .Top = h.Range("P" & fila).Top
                .Left = h.Range("P" & fila).Left
                .Width = h.Range("P" & fila).Width
                .Height = h.Range("P" & fila).Height
            End With
            '
            h.Range("Q" & fila).Value = Label19.Caption
            'eliminamos el objeto
            Set fotografia = Nothing
        End If
    End If

Y para pasar los datos al formato:

Private Sub btncargar_Click()
'Por.Dante Amoe
    If TextBox1.Value = "" Or Not IsNumeric(TextBox1.Value) Then
        MsgBox "Captura un número de informe"
        TextBox1.SetFocus
        Exit Sub
    End If
    '
    num = Val(TextBox1.Value)
    Set h1 = Sheets("BaseDeDatos")
    Set h2 = Sheets("Formato")
    Set b = h1.Columns("A").Find(num, lookat:=xlValue)
    If Not b Is Nothing Then
        'LLENAR FORMATO
        h2.Range("E5").Value = h1.Cells(b.Row, "A").Value 'num informe
        h2.Range("E7").Value = h1.Cells(b.Row, "B").Value 'fecha informe
        h2.Range("E9").Value = h1.Cells(b.Row, "C").Value 'no. aviso
        '
        'continuar con los demás datos
        '
        '
        'Cargar imagen
        arch = h1.Cells(b.Row, "Q").Value
        If arch <> "" Then
            If Dir(arch) <> "" Then
                Set fotografia = h2.Pictures.Insert(arch)
                '
                With fotografia
                    '.Name = "foto de la imagen"
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Top = h2.Range("B45").Top
                    .Left = h2.Range("B45").Left
                    .Width = h2.Range("B45:Q56").Width
                    .Height = h2.Range("B45:Q56").Height
                End With
                'FOTO
                'eliminamos el objeto
                Set fotografia = Nothing
            End If
        End If
        MsgBox "Formato lleno"
    Else
        MsgBox "El número no existe"
        TextBox1.SetFocus
    End If
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas