¿Cómo puedo guardar esa imagen Capturada en una base de datos mediante la misma Macro?
Yo tengo un Libro de excel que tiene 2 Hojas, una Hoja donde capturo la imagen y otra Hoja vendría siendo la Base de Datos. Lo que quiero es que en la misma macro que utilice para hacer capture me Guarde esa imagen ya capturada en una base de datos osea en la otra hoja.
Esta es la macro que seguí para hacer un capture.
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
2 Respuestas
Y si quiero que se guarde como archivo JPEG y que a su vez se guarde en mi hoja de Base de datos
¿Ojo qué se guarde en la hoja es la ubicación de la imagen me entidende?
Ya no entendí, quieres guardar la imagen en la celda F2 o quieres guardar solamente el nombre de la carpeta y el nombre del archivo en la celda F2
En la imagen que pusiste en la celda F2 está vacía, por eso no entiendo cuál es el resultado que quieres.
Quiero guardar la ubicación de la imagen en la celda f2
Te anexo la macro con los cambios
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
' u = h3.Range("F" & Rows.Count).End(xlUp).Row + 1
' 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
h3.Range("F" & u).Value = 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 Sub.
.Sal u dos. Dante Amor. Avísame cualquier duda. R ecuerda valorar la respuesta. G racias
.
WUo! Se lo agradezco mucho no tiene la menor idea el detalle es que el motivo al yo guardarla con su dirección de unabicion es que me salga un Hipervínculo para al darle click me enseñe la imagen. ¿Podría ayudarme con eso?
Va la macro actualizada
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
'
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.
