Excel como limitar botão print para frame

Eri França · 21 de julho de 2020

Bom dia!

o código abaixo gera um print do formulário como um todo, gostaria de limitar o recorte a informação dentro do Frame

Private Sub Bt_Print_Click()

Dim tmpSheet As Worksheet
Dim tmpChart As ChartPasta1.rar
Dim tmpImg As Object
Dim fJPG As String
Dim margem As Integer

On Error GoTo erro

Application.DisplayAlerts = False
Application.ScreenUpdating = False
DoEvents

keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0

DoEvents

'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

Application.Wait Now + TimeValue("00:00:01")

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 = 2000
With .Parent
.Height = tmpImg.Height + margem
.Width = tmpImg.Width + margem
End With
End With
'localização e nome do ficheiro de imagem
fJPG = ThisWorkbook.Path & _
"\imagem_" & Format(Now, "ddmmyyyy_hhmmss") & ".jpg"
'exportar grafico
tmpChart.Export Filename:=fJPG, FilterName:="jpg"
'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:" & fJPG, _
vbInformation, _
"Exportar para JPG"
GoTo Fim
erro:
MsgBox "Erro: " & Err.Description, _
vbCritical, _
"Erro: " & Err.Number
Fim:
Set tmpSheet = Nothing
Set tmpChart = Nothing
Set tmpImg = Nothing

'Unload Me

End Sub

Midori · 21 de julho de 2020

@Eri França Isso pode ser feito com as propriedades de Shape depois do print,

Set Recortar = tmpChart.Shapes("chart")
    
Recortar.PictureFormat.Crop.PictureOffsetY = -100
Recortar.PictureFormat.Crop.ShapeHeight = 300
Recortar.PictureFormat.Crop.ShapeWidth = 300

Em OffsetY desloquei -100 para não pegar o caption do form e fiz o recorte de 300x300. Aí você deve alterar os valores para ajustar o tamanho que achar melhor.

Eri França · 21 de julho de 2020

@Midori

Bom dia Midori!

coloquei o seu código logo após a parte onde eu defino a dimensão da imagem, porém ele da o erro de Variável não definida para o "Recortar", onde eu errei?

With .Parent
.Height = tmpImg.Height + margem
.Width = tmpImg.Width + margem
End With
End With
Set Recortar = tmpChart.Shapes("chart")

Recortar.PictureFormat.Crop.PictureOffsetY = -100
Recortar.PictureFormat.Crop.ShapeHeight = 300
Recortar.PictureFormat.Crop.ShapeWidth = 300
'localização e nome do ficheiro de imagem
fJPG = ThisWorkbook.Path & _
"\imagem_" & Format(Now, "ddmmyyyy_hhmmss") & ".jpg"
'exportar grafico
tmpChart.Export Filename:=fJPG, FilterName:="jpg"
'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:" & fJPG, _
vbInformation, _
"Exportar para JPG"
GoTo Fim