Como cambiar de Pictures.Insert a Shapes.AddPicture

Realicé esta macro con Pictures.Insert para traer unas imágenes, pero me di cuenta que la trae como un vínculo, y vi que la correcta es Shapes. AddPicture, quién me ayuda a arreglarlo por favor.

Sub Macro2()
'
' Macro2 Macro
'
' Acceso directo: CTRL+s
'
Dim fotox1 As String
Dim fotox2 As String
Dim fotox3 As String
Dim fotox4 As String
Dim fotox5 As String
Dim fotox6 As String
Dim cantidad As Long
Dim dircarpeta As String
Dim nomarchivo As String
Dim OS As Long
Dim fecha As Date
Dim DIR As String
Dim proyecto As String

nomarchivo = Worksheets("RG03-IO2097 (1)").Range("p14").Value
cantidad = Worksheets("RG03-IO2097 (1)").Range("p8").Value
dircarpeta = Worksheets("RG03-IO2097 (1)").Range("p1").Value
fotox1 = Worksheets("RG03-IO2097 (1)").Range("p16").Value
fotox2 = Worksheets("RG03-IO2097 (1)").Range("p17").Value
fotox3 = Worksheets("RG03-IO2097 (1)").Range("p18").Value
fotox4 = Worksheets("RG03-IO2097 (1)").Range("p19").Value
fotox5 = Worksheets("RG03-IO2097 (1)").Range("p20").Value
fotox6 = Worksheets("RG03-IO2097 (1)").Range("p21").Value
OS = Worksheets("RG03-IO2097 (1)").Range("s3").Value
fecha = Worksheets("RG03-IO2097 (1)").Range("s4").Value
DIR = Worksheets("RG03-IO2097 (1)").Range("s5").Value
proyecto = Worksheets("RG03-IO2097 (1)").Range("s2").Value

If cantidad >= 1 Then
Range("c15:g31").Select
ActiveSheet.Pictures.Insert(dircarpeta & "\" & fotox1 & ".jpeg").Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Height = 226.7716535433
Selection.ShapeRange.IncrementLeft 51.75
Selection.ShapeRange.IncrementTop 8.25
Range("H15:L31").Select
ActiveSheet.Pictures.Insert(dircarpeta & "\" & fotox2 & ".jpeg").Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Height = 226.7716535433
Selection.ShapeRange.IncrementLeft 51.75
Selection.ShapeRange.IncrementTop 8.25

Range("c32:g48").Select
ActiveSheet.Pictures.Insert(dircarpeta & "\" & fotox3 & ".jpeg").Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Height = 226.7716535433
Selection.ShapeRange.IncrementLeft 51.75
Selection.ShapeRange.IncrementTop 8.25

Range("H32:L48").Select
ActiveSheet.Pictures.Insert(dircarpeta & "\" & fotox4 & ".jpeg").Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Height = 226.7716535433
Selection.ShapeRange.IncrementLeft 51.75
Selection.ShapeRange.IncrementTop 8.25
End If
If cantidad >= 5 Then
Range("c49:g65").Select
ActiveSheet.Pictures.Insert(dircarpeta & "\" & fotox5 & ".jpeg").Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Height = 226.7716535433
Selection.ShapeRange.IncrementLeft 51.75
Selection.ShapeRange.IncrementTop 8.25
End If
If cantidad = 6 Then
Range("H49:L65").Select
ActiveSheet.Pictures.Insert(dircarpeta & "\" & fotox6 & ".jpeg").Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Height = 226.7716535433
Selection.ShapeRange.IncrementLeft 51.75
Selection.ShapeRange.IncrementTop 8.25
End If

Range("E8").Select
ActiveCell.Value = OS

Range("E10").Select
ActiveCell.Value = fecha

Range("E13").Select
ActiveCell.Value = DIR

Range("I8").Select
ActiveCell.Value = proyecto

ActiveWorkbook.SaveAs Filename:=dircarpeta & "\" & nomarchivo

Range("p1:s25").Clear
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 2")).Select
Selection.Delete
Sheets("Hoja1").Delete

End Sub

Añade tu respuesta

Haz clic para o