Como cambiar la ruta de una imagen utilizando el valor de una celda para cambiar parte de la ruta.
Hola mi problema es el siguiente esperemos me puedan ayudar.
Tengo una macro que Rellena unas formas con imágenes que están en un cierto archivo con carpetas ID xxxx las cuales contienen las imágenes con el nombre id xxxx A.jpg o id xxxx b.jpg y necesito que cuando yo cambie el nombre de la celda con rango "E10:G10" ese numero de id se cargue en las rutas y se dispare la macro para que se guarde con ese nombre en cierta carpeta y me genere un pdf automáticamente hasta ahora e cambiado el nombre de las rutas y disparado la macro manualmente.
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
Como se dan cuenta al ver mi macro no se mucho pero he estado investigando ya me avente completo el tuto de vba de video2brain y aun asi no pude encontrar solucion espero me puedan ayudar de antemano muchas gracias.
