Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Range salva como im...
 
Notifications
Clear all

Range salva como imagem com baixa qualidade!!!

 
2024 - VBA & Macros
Post Recente por Fuchado 10 anos atrás
7 Posts
2 Usuários
0 Reactions
1,540 Visualizações
RSS
 Fuchado
(@fuchado)
Posts: 0
New Member
Topic starter
 

Bom Dia Senhores !

tenho um código VBA que salva um determinada Range como imagem num diretório como pasta e nome definidos...

Bom, o código é este:

Sub Salvar_Imagem()

 Dim rgExp As Range: Set rgExp = Sheets("Base").Range("A1:U27")

 rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

 With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
 Width:=rgExp.Width, Height:=rgExp.Height)
 .Name = "ChartVolumeMetricsDevEXPORT"
 .Activate
 vHora = Range("U1")
 vDia = Range("U2")
 End With

 ActiveChart.Paste
 ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "M:PromissaoCOE AgricolaDisponibilidade201412. DEZEMBRO" & vDia & "" & vHora & ".png"
 ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete

End Sub

Acontece que a imagem salva fica embaçada e com pouca definição.
Antes eu selecionava e colava no MSPaint, que por sinal traz uma imagem muito boa!

A pergunta é: Será que é possível melhorar a imagem como o auxilio do MSPaint ???

Valeu Galerinha do Mal :lol:

 
Postado : 18/12/2014 5:26 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bo atarde Fuchado

Seja bem-vindo ao fórum!

Movi teu tópico para VBA & Macros que é o assunto da tua dúvida.

Por enquanto vou deixar sendo mostrado nos 2 locais para você localizar o tópico.

[]s

 
Postado : 18/12/2014 10:12 am
 Fuchado
(@fuchado)
Posts: 0
New Member
Topic starter
 

Muito Obrigado Patropi !

Caso Possa me ajudar serei ainda mais grato!

 
Postado : 18/12/2014 10:45 am
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Não sei se melhora a imagem, pois o que uso fica com boa qualidade (acho eu).
o formato que utilizo é xlPicture (não xlBitmap); experimente também o formato jpg

Sub SalvarRangeImagem()
Dim rgExp As Range
Dim oCht As Chart
Dim sPath As String, tImg As String
Set rgExp = Sheets("Base").Range("A1:U27")
'Determina o tipo de arquivo a ser salvo - Pode ser Gif, Png ou Jpg (gif/png resultam em arquivos menores)
tImg = "png"

rgExp.CopyPicture Appearance:=xlScreen, Format:=xlPicture

With rgExp
    .CopyPicture xlScreen, xlPicture 'xlBitmap
    Set oCht = ActiveSheet.ChartObjects.Add(50, 50, .Width + 5, .Height + 5).Chart
End With
vHora = Range("U1")
vDia = Range("U2")
sPath = "M:PromissaoCOE AgricolaDisponibilidade201412. DEZEMBRO" & vDia & "" & vHora & "." & tImg
With oCht
    .Paste
    .Shapes(1).Left = -.ChartArea.Left
    .Shapes(1).Top = -.ChartArea.Top
    .Parent.Width = rgExp.Width
    .Parent.Height = rgExp.Height
    .Export Filename:=sPath, FilterName:=tImg
    .Parent.Delete
End With
End Sub
 
Postado : 18/12/2014 11:07 am
 Fuchado
(@fuchado)
Posts: 0
New Member
Topic starter
 

Caro Reinaldo...

A imagem em png fica semelhante a aquela gerada com o código anterior, já em jpg a resolução acaba baixando um pouco.

eu fiz uma comparação com uma imagem que foi salva pelo paint e a diferença é considerável;

estava pensando... será que é possível abrir o paint colar lá e fazê-lo salvar como pelo VBA ?
estive pesquisando e encontrei um tal de shell(mspaint)...
Mas nada que me ajudasse.

 
Postado : 18/12/2014 12:17 pm
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Abrir o paint, é simples utilizando o comando shell, porem colar e salvar como, creio que não é possível, ou pelo menos eu não conheço como faze-lo em VBA.
Porem fiz manualmente, e não vi diferença entre o salvo via vba e o salvo com o paint.

 
Postado : 18/12/2014 12:46 pm
 Fuchado
(@fuchado)
Posts: 0
New Member
Topic starter
 

Poxa que pena...

bom mostrei aos meus amigos de trabalho e eles concordaram que existe uma razoável diferença...

Que seja!

Reinaldo Obrigado pela Atenção!!!

 
Postado : 18/12/2014 1:25 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico