Te anexo la macro
Private Sub btncargar_Click()
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