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
Respuesta de Dante Amor
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 IfY 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 Subsal u dos
