¿Como ponerle nombre desde una rango de excel a una capture de la hoja?
Use su código y me funciono, la cosa es que quiero que en esa misma macro pueda colocarle el nombre de la imagen Capturada mediante un Rango determinado dentro de la hoja que e capturado . (No se si me explico)Si podría ayudarme con esto se lo agradecería mucho.
1 respuesta
No estoy entendiendo bien qué necesitas.
Explico lo que hace la macro:
- La macro copia un rango de celdas
- Guarda ese rango de celdas como una imagen
- Genera un archivo .jpeg y le pone por nombre el dato que está contenido en una celda.
Así como lo expliqué, qué necesitas que haga la macro.
La macro que utilizas es esta:
Sub CopiarCeldasComoImagen()
'Por.Dante Amor
'
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja2")
Set h2 = Sheets.Add
ruta = ThisWorkbook.Path & "\"
archivo = ruta & h1.[D1] & ".JPEG"
'
rango = "A1:C10"
'
With h1.Range(rango)
fi = .Cells(1, 1).Row
ff = .Rows.Count + fi - 1
ci = .Cells(1, 1).Column
cf = .Columns.Count + ci - 1
izq = .Cells(1, 1).Left
der = h1.Cells(1, cf + 1).Left
baj = .Cells(1, 1).Top
arr = h1.Cells(ff + 1, 1).Top
anc = der - izq
alt = arr - baj
End With
'
h1.Range(rango).CopyPicture
h2.Shapes.AddChart
With h2.ChartObjects(1)
.Width = anc
.Height = alt
.Chart.Paste
.Chart.Export archivo
.Delete
End With
Application.DisplayAlerts = False
h2.Delete
Application.DisplayAlerts = True
'
MsgBox "Celdas guardadas como imagen en el archivo: " & archivo, vbInformation, Date
End Sub
Solamente por si quisieras poner la imagen la celda:
Sub CopiarCeldasComoImagen()
'Por.Dante Amor
'
Application.ScreenUpdating = False
Set h1 = Sheets("Planilla de Solicitud")
Set h3 = Sheets("BASE DE DATOS")
ruta = ThisWorkbook.Path & "\"
archivo = ruta & h1.[D1] & ".JPEG"
'
rango = "A1:C10"
'
h1.Range(rango).CopyPicture
'
'copia la imagen en la celda de la base de datos
h3.Select
h3.Paste
With Selection
.Placement = xlFreeFloating
.ShapeRange.LockAspectRatio = msoFalse
.Top = h3.Range("F" & u).Top
.Left = h3.Range("F" & u).Left
.Width = h3.Range("F" & u).Width
.Height = h3.Range("F" & u).Height
End With
'
'
u = h3.Range("F" & Rows.Count).End(xlUp).Row + 1
h3.Range("F" & u).Value = archivo
h3.Hyperlinks.Add Anchor:=h3.Range("F" & u), Address:=h3.Range("F" & u).Value, _
TextToDisplay:="Ver imagen " & archivo
'
'Guarda imagen como archivo
Set h2 = Sheets.Add
h2.Shapes.AddChart
With h2.ChartObjects(1)
.Width = h1.Range(rango).Width
.Height = h1.Range(rango).Height
.Chart.Paste
.Chart.Export archivo
.Delete
End With
Application.DisplayAlerts = False
h2.Delete
Application.DisplayAlerts = True
'
MsgBox "Celdas guardadas como imagen en el archivo: " & archivo, vbInformation, Date
End Subsal u dos, no olvides valorar las respuestas.
Señor dante me funciono de maravilla pero no quiero que mi imagen lleve "Ver Imagen" como haría para que solo me tragera la ruta pero sin ese "Ver Imagen"
Se lo quito y no me abre la imagen
h3.Hyperlinks.Add Anchor:=h3.Range("F" & u), Address:=h3.Range("F" & u).Value, _
TextToDisplay:="Ver imagen " & archivo
Prueba así:
h3.Hyperlinks.Add Anchor:=h3.Range("F" & u), Address:=h3.Range("F" & u).Value, _
TextToDisplay:=""
No funciona así, ya lo intente antes y ahora también por si acaso y no
h3.Hyperlinks.Add Anchor:=h3.Range("F" & u), Address:=h3.Range("F" & u).Value, _
TextToDisplay:=archivoo
h3.Hyperlinks.Add Anchor:=h3.Range("F" & u), Address:=h3.Range("F" & u).Value, _
TextToDisplay:=h3.Range("F" & u).Value
