Saltar para: Post [1], Comentários [2], Pesquisa e Arquivos [3]

Code Snippets Blog

Pequenas rotinas em vba, vbscript e outras linguagens. Noticias sobre informática, workshops, e outras coisas relacionadas com novas tecnologias.

Code Snippets Blog

Pequenas rotinas em vba, vbscript e outras linguagens. Noticias sobre informática, workshops, e outras coisas relacionadas com novas tecnologias.

30
Dez07

Excel - Exportar área de uma worksheet para uma imagem

Dúvida: "Em uma planilha tenho alguns lançamentos que abrangem da celula B2 até J20, então seleciono os dados, copio e com o Shift pressionado clico em Editar e tem a opção Colar Figura, e é inserido uma cópia como uma figura, agora o que eu gostaria de saber é se tem como salvar essa figura no diretório armazenando  para poder visualiza-la como se fosse uma imagem.A intenção com isso é que nessa planilha são feitos pedidos e em vez de gerar uma cópia como arquivo do excel, gostaria que fossem como uma imagem que se possa abri-la para imprimir."

Solução: Macro que copia a selecção activa, ou uma área predefinida, como imagem para um área de grafico, e executa a exportação usando o filtro gif.
 

Area selecionada para copiar como imagem
Resultado já em ficheiro gif

 

Sub ExportarAreaParaGif()
    '
' http://jjoao2k.no.sapo.pt
' Objectivo: exportar uma area para um ficheiro de imagem
' usando o filtro GIF
'
Dim tmpSheet As Worksheet Dim tmpChart As Chart Dim tmpImg As Object Dim fGIF As String Dim margem As Integer On Error GoTo erro '
'caso seja uma area fixa a copiar
'Range([area_a_copiar]).CopyPicture _
' Appearance:=xlScreen, _
' Format:=xlBitmap
'
'usar a selecção activa
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap 'impede que se veja a acção acelerando o procedimento de cópia
'e exportação
Application.ScreenUpdating = False 'uma folha para colocarmos o grafico sem atrapalhar o resto
Set tmpSheet = Worksheets.Add 'colocar um grafico nesta nova folha
Charts.Add 'definições essenciais ao grafico, para que fique numa worksheet
'e não numa folha grafico
ActiveChart.Location Where:=xlLocationAsObject, Name:=tmpSheet.Name 'Colar a zona copiada para dentro da area do grafico
Set tmpChart = ActiveChart With tmpChart .Paste Set tmpImg = Selection With .ChartArea '--------->
'(não essencial ao funcionamento da rotina)
'coloca um degrade no fundo do grafico
.Fill.OneColorGradient _ Style:=msoGradientHorizontal, _ Variant:=1, _ Degree:=0.231372549019608 '<----------
'sem linha de rebordo
.Border.LineStyle = xlNone End With 'configurar a area do grafico acrescentando
'uma pequena borda ao redor da imagem centrando esta
margem = 8 With .Parent .Height = tmpImg.Height + margem .Width = tmpImg.Width + margem End With End With 'localização e nome do ficheiro de imagem
fGIF = ThisWorkbook.Path & _ "\imagem_" & Format(Now, "yyyymmdd_hhmmss") & ".gif" 'exportar grafico
tmpChart.Export Filename:=fGIF, FilterName:="gif" 'eliminar a folha temporaria sem avisos
Application.DisplayAlerts = False tmpSheet.Delete Application.DisplayAlerts = True 'repor o estado normal
Application.ScreenUpdating = True 'aviso de operação terminada
MsgBox "Imagem exportada para o ficheiro:" & fGIF, _ vbInformation, _ "Exportar para GIF" GoTo fim erro: MsgBox "Erro: " & Err.Description, _ vbCritical, _ "Erro: " & Err.Number fim: Set tmpSheet = Nothing Set tmpChart = Nothing Set tmpImg = NothingEnd Sub

 

Fonte: http://jjoao2k.no.sapo.pt

 

2 comentários

Comentar post