Mostrar rango de celdas en userform como imagen

Les comento mi situación.. Tengo el siguiente código, gentileza de Dante.. La macro crea una imagen del rango y la muestra en un control imagen el un userform.. El tema es que la imagen que copia está en blanco.. En las celdas ahí números unas imágenes flechas.. No es sólo celdas con números.. Es como un gráfico compuesto de umagenes, celdas con información y flechas de dirección.. El tema es que la imagen resultante del rango está toda en blanco.. Me ayudan.? Si es necesario envío el archivo así lo ven y me ayudan mejor.. Garcias

Private Sub UserForm_Activate()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Hoja2")
    Set h2 = Sheets.Add
    archivo = ThisWorkbook.Path & "\" & "temp.jpeg"
    '
    rango = "A1:F18"                'Poner el rango a mostrar
    '
    anc = h1.Range(rango).Width
    alt = h1.Range(rango).Height
    '
    h1.Range(rango).CopyPicture
    h2.Shapes.AddChart
    With h2.ChartObjects(1)
        .Width = anc + 2
        .Height = alt + 2
        .Chart.Paste
        .Chart.Export archivo
        .Delete
    End With
    h2.Delete
    '
    Image1.Picture = LoadPicture(archivo)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = True
End Sub

1 Respuesta

Respuesta
1

Probé el código y sí me muestra la imagen, con formatos y con todo e imágenes.

Entra a tu userform, selecciona el userform, en propiedades, busca la propiedad PictureSizeMode y cambia a "1-fmPictureSizeModeStretch"

Prueba nuevamente.

¿Qué versión de excel tienes?

Ya lo cambie y tampoco.. sale en blanco.. me guarda un archivo .JPEG en la carpeta dónde está el excel pero también en blanco.. tengo excel 2016.. será por eso.?

He probado con otra hoja o otro es como y me sale igual.. la imagen temp que crea sale en blanco también.. no sé cómo hacer para transformar en una imagen mi rango de celdas y mostrarlo en el control imagen.. la hoja se llama PP y el rango es B2:Z58.. será que es mucho el rango.? Probé con rangos más pequeños y tampoco sale..

Ya busque información y parece que el problema es la versión del excel.. por eso sale en blanco.. sabrías cómo hacerlo compatible con mi versión.?

Yo tengo 2007 y no tengo problemas

Ya revisé otras páginas y es la única forma

. Chart. Export archivo

Mira lo que encontré

En versiones recientes de Excel el código exporta una imagen en blanco, al parecer no se permite pegar la imagen sin activar antes el ChartObject, por lo que se tiene que agregar una línea adicional al código quedando como sigue.

En este código según entiendo hace imagen un rango pero no veo en dónde colocar el rango.. y verás que dice la línea que se agrega por esto del excel más nuevo.. cómo podemos adaptarla.?

Public Sub RangoImagen(Rango As Excel.Range, Archivo As String)
    Dim Imagen As Chart
    Dim Result As Boolean
    With Rango
        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Set Imagen = Rango.Parent.ChartObjects.Add(10, 10, .Width, .Height).Chart
    End With
    Imagen.Parent.Activate'Nueva linea 2018-05-06
    Imagen.Paste
    Imagen.ChartArea.Border.LineStyle = 0
    Imagen.ChartArea.Width = Imagen.ChartArea.Width * 3
    Imagen.ChartArea.Height = Imagen.ChartArea.Height * 3
    On Error Resume Next
    Kill Archivo
    Result = Imagen.Export(Archivo)
    Imagen.Parent.Delete
    Set Imagen = Nothing
    If Result Then
        MsgBox "Correcto. Se ha creado la imagen del rango"
    Else
        MsgBox "Error. " & Err.Description
    End If
End Sub

Prueba así

Private Sub UserForm_Activate()
    Dim Imagen As Chart
    Dim Result As Boolean
    Archivo = ThisWorkbook.Path & "\" & "paso.jpeg"
    Sheets("PP").Select
    With Range("B2:Z58")
        .CopyPicture Appearance:=xlScreen, Format:=xlPicture
        Set Imagen = .Parent.ChartObjects.Add(10, 10, .Width, .Height).Chart
    End With
    Imagen.Parent.Activate 'Nueva linea 2018-05-06
    Imagen.Paste
    Imagen.ChartArea.Border.LineStyle = 0
    Imagen.ChartArea.Width = Imagen.ChartArea.Width * 3
    Imagen.ChartArea.Height = Imagen.ChartArea.Height * 3
    On Error Resume Next
    Kill Archivo
    Result = Imagen.Export(Archivo)
    Imagen.Parent.Delete
    Set Imagen = Nothing
    If Result Then
        Image1.Picture = LoadPicture(Archivo)
        MsgBox "Correcto. Se ha creado la imagen del rango"
    Else
        MsgBox "Error. " & Err.Description
    End If
End Sub

Prácticamente hace lo mismo, crea un Char para pegar la imagen y después exporta la imagen como archivo, por último carga el archivo en el userform.

Ya lo probé en mi versión de excel y también me funciona. 

[sal u dos

¡Gracias! 

Excelente dan.. funciona a la perfección.. podríamos hacer algún tema relacionado con este cambio para versiones más recientes.. abrazo y gracias de nuevo

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas