Menu
 
 
 
 
 
 


Valid XHTML 1.0 Transitional
Valid CSS!

Visual Basic for Application:

Exportar area de uma worksheet para um Imagem - JJoão (10/2006)

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 area predefinida, como imagem para um area 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 = Nothing
End Sub
Utilidades
 
Transito em directo
 
O Tempo
 
Gerador de Chaves
 
Moedas - Taxas e Cambios
 
 
 
 
 
Classifique o nosso website
@ MUNDOPT.COM
 
Topo