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