Como cambiar la ruta de una imagen utilizando el valor de una celda para cambiar parte de la ruta.

El echo es que necesito cambiar una ruta para que cada que yo cambie el valor de una celda ese valor se cargue en donde mi ruta tiene números y esos números me los cambie por los de la celda seleccionada la cual Seria una celda combinada de rango "E10;G10"

Y que

MI CÓDIGO ES EL SIGUIENTE

Sub ABRefill()
Dim celda As Long
celda = Cells(5, 10).Value
Sheets("TELMEX PRUEBAS EN SITIO").Activate
ActiveSheet.Shapes.Range(Array("FORMA")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("FORMAB")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("FORMAC")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("FORMAD")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("FORMAE")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("FORMAF")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("FORMAG")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Solid
End With
ActiveSheet.Shapes.Range(Array("1 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " A.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ActiveSheet.Shapes.Range(Array("2 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " B.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ActiveSheet.Shapes.Range(Array("12 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " C.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ActiveSheet.Shapes.Range(Array("13 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " D.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ActiveSheet.Shapes.Range(Array("14 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " E.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ActiveSheet.Shapes.Range(Array("17 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " F.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
ActiveSheet.Shapes.Range(Array("18 Rectangle")).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture "C:\EXCELINE DUIDA\IMÁGENES DUIDA\ID's\ID " & celda & "\ID " & celda & " G.JPG"
.TextureTile = msoFalse
.RotateWithObject = msoTrue
End With
Sheets("BASE DE DATOS").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets(Array("TELMEX REPORTE GRAFICO", "TELMEX PRUEBAS EN SITIO")).Select
Sheets("TELMEX REPORTE GRAFICO").Activate
ChDir "C:\EXCELINE DUIDA\REPORTES\Entrega\ID'S PARA ENTREGAR\Entregados"
ActiveWorkbook.SaveAs Filename:= _
"C:\EXCELINE DUIDA\REPORTES\Entrega\ID'S PARA ENTREGAR\Entregados\ID 82.xlsx", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\EXCELINE DUIDA\REPORTES\Entrega\ID'S PARA ENTREGAR\Entregados\ID 82.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub

Añade tu respuesta

Haz clic para o