Guardar imagen de un Din A4

... guardar una imagen... tamaño de un DINA4 y me sale un tanto distorsionada (primer problema)
... guardarla... con el nombre... registrado en la variable "nombreimagen" y no acierto a componer la dirección correcta
... la archiva como "C:\IMAGENES DE FICHAS DE CLIENTES\_&nombreimagen_&" y no... con el valor... de la celda C10...

GuardarImagen()
' GuardarImagen Macro
' Macro grabada el 15/07/2009 por hes040
' Acceso directo: Ctrl+Mayús+x
Dim choObj As ChartObject, chGráf As Chart, ptImagen As Object
Dim blnGuardado As Boolean
Dim nombreimagen As String
Worksheets("Reverso ficha").Range("A1:J73").CopyPicture appearance:=xlScreen, Format:=xlPicture
nombreimagen = Range("C10").Value
'MsgBox prompt:=nombreimagen
Set choObj = ActiveSheet.ChartObjects.Add(0, 0, 800, 600)
Set chGráf = choObj.Chart
choObj.Activate
chGráf.ChartArea.Select
chGráf.Paste
Set ptImagen = chGráf.Pictures(1)
ptImagen.Left = 0
ptImagen.Top = 0
choObj.Border.LineStyle = xlNone
choObj.Width = ptImagen.Width + 7
choObj.Height = ptImagen.Height + 7
blnGuardado = chGráf.Export(Filename:="C:\IMAGENES DE FICHAS DE CLIENTES\_&nombreimagen_&", filtername:="GIF")
If Not blnGuardado Then MsgBox prompt:="Problemas al guardar la imagen.", Buttons:=vbOKOnly + vbExclamation
choObj.Delete
Set choObj = Nothing
Set chGráf = Nothing
Set ptImagen = Nothing
End Sub

hola, José Rafael !

... guardar una imagen... tamaño de un DINA4 y me sale un tanto
distorsionada (primer problema)
... guardarla... con el nombre... registrado en la variable
"nombreimagen" y no acierto a componer la dirección correcta
... la archiva como "C:\IMAGENES DE FICHAS DE CLIENTES\_&nombreimagen_&"
y no... con el valor... de la celda C10...

prueba con algo +/- como lo siguiente:

Sub GuardarImagen()
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Application.DisplayAlerts = False
With Range("a1:j73")
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "c:\imagenes de fichas de clientes\_" & Range("c10") &
"_.gif"
.Delete
End With
Application.DisplayAlerts = True
End Sub

saludos,
hector.

__ el codigo expuesto __

GuardarImagen()
' GuardarImagen Macro
' Macro grabada el 15/07/2009 por hes040
' Acceso directo: Ctrl+Mayús+x
Dim choObj As ChartObject, chGráf As Chart, ptImagen As Object
Dim blnGuardado As Boolean
Dim nombreimagen As String
Worksheets("Reverso ficha").Range("A1:J73").CopyPicture
appearance:=xlScreen, Format:=xlPicture
nombreimagen = Range("C10").Value
'MsgBox prompt:=nombreimagen
Set choObj = ActiveSheet.ChartObjects.Add(0, 0, 800, 600)
Set chGráf = choObj.Chart
choObj.Activate
chGráf.ChartArea.Select
chGráf.Paste
Set ptImagen = chGráf.Pictures(1)
ptImagen.Left = 0
ptImagen.Top = 0
choObj.Border.LineStyle = xlNone
choObj.Width = ptImagen.Width + 7
choObj.Height = ptImagen.Height + 7
blnGuardado = chGráf.Export(Filename:="C:\IMAGENES DE FICHAS DE
CLIENTES\_&nombreimagen_&", filtername:="GIF")
If Not blnGuardado Then MsgBox prompt:="Problemas al guardar la
imagen.", Buttons:=vbOKOnly + vbExclamation
choObj.Delete
Set choObj = Nothing
Set chGráf = Nothing
Set ptImagen = Nothing
End Sub

hola, José Rafael !

eso de "conciso"... no siempre puedo serlo (lo demas tampoco, pero
igual...)
te agradezco los comentarios (y el ofrecimiento) :))

saludos,
hector.

Me ha surgido una demanda nueva... y es que una vez hecha " la foto" de la ficha
tengamos la posibilidad de enviarlo por correo electronico mediante Outlook 2003
(supongo que me abrirá la aplicación y me dará opción de elegir al destinatario).
... ahora necesitaría tener ademas la posibilidad de enviarlo tambien por correo electronico (si lo necesitara)...