Se me repite la imagen en ambas ventanas

Duda sobre me repite la imagen y debería ser otra cuando guardo

Dante mira se me repite la imagen pero en la hoja base de datos y cuando guarde los datos e imágenes adjunte otra imagen, en la segunda imagen. Por ende debería mostrarme la otra imagen no la misma. Adjunto foto de como me exportó, y adjunto foto del código

'Cargar imagen UNO
On Error Resume Next
h2.DrawingObjects("B35").Delete
On Error GoTo 0
arch = h1.Cells(b.Row, "Q").Value
If arch <> "" Then
If Dir(arch) <> "" Then
Set fotografia = h2.Pictures.Insert(arch)
'
With fotografia
.Name = "B35"
.ShapeRange.LockAspectRatio = msoFalse
.Top = h2.Range("B35").Top
.Left = h2.Range("B35").Left
.Width = h2.Range("B35:Q44").Width
.Height = h2.Range("B35:Q44").Height
End With
'FOTO
'eliminamos el objeto
Set fotografia = Nothing
End If
End If
'Cargar imagen DOS
On Error Resume Next
h2.DrawingObjects("B46").Delete
On Error GoTo 0
arch = h1.Cells(b.Row, "Q").Value
If arch <> "" Then
If Dir(arch) <> "" Then
Set fotografia = h2.Pictures.Insert(arch)
'
With fotografia
.Name = "B46"
.ShapeRange.LockAspectRatio = msoFalse
.Top = h2.Range("B46").Top
.Left = h2.Range("B46").Left
.Width = h2.Range("B46:Q55").Width
.Height = h2.Range("B46:Q55").Height
End With
'FOTO
'eliminamos el objeto
Set fotografia = Nothing
End If
End If

Desearía que la segunda imagen hiciera lo mismo que en la primera, me agregue cuando tenga una imagen adjuntada en la hoja base de datos, y en el caso de que no adjunte foto cuando guarde los datos, de igual manera que no me muestre ninguna foto.

1 Respuesta

Respuesta
1

En esta línea se borra la imagen anterior:

 H2. DrawingObjects("foto1").Delete

No le cambies el nombre "foto1"


En esta otra línea se pone el nombre "foto1"

 .Name = "foto1"

Tampoco le cambies el nombre "foto1"

Y otro detalle la carpeta y el nombre del archivo se almacena en la columna "Q", tampoco le cambies la columna:

        arch = h1.Cells(b.Row, "Q").Value


Esta es la macro completa con los cambios

Private Sub btncargar_Click()
'Por Dante Amor
    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("B21").Value = h1.Cells(b.Row, "C").Value 'no. aviso
        h2.Range("B27").Value = h1.Cells(b.Row, "D").Value 'diagnostico
        h2.Range("E9").Value = h1.Cells(b.Row, "E").Value 'tipomedicion
        h2.Range("M5").Value = h1.Cells(b.Row, "F").Value 'Fechamonitoreo
        h2.Range("B19").Value = h1.Cells(b.Row, "G").Value 'REGISTROEMISOR
        h2.Range("K18").Value = h1.Cells(b.Row, "H").Value 'OTRUTA
        h2.Range("B32").Value = h1.Cells(b.Row, "I").Value 'RECOMENDACION
        h2.Range("K20").Value = h1.Cells(b.Row, "J").Value 'PROGRAMADO POR
        h2.Range("PRIORIDADINTERVENCION").Value = h1.Cells(b.Row, "L").Value 'PRIORIDADINT
        h2.Range("B14").Value = h1.Cells(b.Row, "N").Value 'TAQEQUIPO
        h2.Range("EQUIPOMANOTIR").Value = h1.Cells(b.Row, "O").Value 'DESCRIPCIONEQUIPO
        'h2.Range("P").Value = h1.Cells(b.Row, "FOTO").Value 'FOTO
        '
        'continuar con los demás datos
        '
        '
        'Cargar imagen
        On Error Resume Next
        h2.DrawingObjects("foto1").Delete
        On Error GoTo 0
        arch = h1.Cells(b.Row, "Q").Value
        If arch <> "" Then
            If Dir(arch) <> "" Then
                Set fotografia = h2.Pictures.Insert(arch)
                '
                With fotografia
                    .Name = "foto1"
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Top = h2.Range("B37").Top
                    .Left = h2.Range("B46").Left
                    .Width = h2.Range("B37:P46").Width
                    .Height = h2.Range("B37:P46").Height
                End With
                'FOTO
                'eliminamos el objeto
                Set fotografia = Nothing
            End If
        End If
        MsgBox "Cargando PDF"
        TextBox1.SetFocus
    End If
    '/
     ruta = ThisWorkbook.Path & "\"
    arch = "numero informe " & Sheets("Formato").Range("E5").Value & ".pdf"
    Sheets("Formato").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & arch, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas