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
En esta línea se borra la imagen anterior:
H2. DrawingObjects("foto1").DeleteNo 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 Subsal u dos
