Excel VBA - Lista de Constantes e Respectivos Valores - List of Excel Charting Constants and Enumerations for VBA
Deixe seus comentários, compartilhe este artigo!
⬛◼◾▪ CONTATO ▪◾◼⬛
✔ VBA Excel Specialist® - Quaisquer soluções e/ou desenvolvimento de aplicações pessoais, ou da empresa, que não constem neste Blog podem ser tratados como consultoria freelance. Contate-nos: brazilsalesforceeffectiveness@gmail.com | ESTE BLOG NÃO SE RESPONSABILIZA POR QUAISQUER DANOS PROVENIENTES DO USO DOS CÓDIGOS AQUI POSTADOS EM APLICAÇÕES PESSOAIS OU DE TERCEIROS.
Deixe seus comentários, compartilhe este artigo!
Sub ExAddingNewChartforSelectedData_ChartObjects_Add_Method()With ActiveSheet.ChartObjects.Add(Left:=300, Width:=300, Top:=10, Height:=300).Chart.SetSourceData Source:=Sheets("Temp").Range("C5:D7")End With
End SubDeixe seus comentários, compartilhe este artigo!

Sub ExAddingNewChartforSelectedData_Charts_Add_Method_InSheet()Range("C5:D7").SelectActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"End Sub
Charts.Add
Deixe seus comentários, compartilhe este artigo!
SubExAddingNewChartforSelectedData_Shapes_AddChart_Method()
ActiveSheet.Shapes.AddChart.Select
Range("F5:I7").Select
End SubDeixe seus comentários, compartilhe este artigo!
'Here is the other method to add charts using Chart Object. It will add a new chart for the selected data as new chart sheet.
Sub ExAddingNewChartforSelectedData_Charts_Add_Method_SheetChart()Range("C5:D7").SelectCharts.Add
End SubDeixe seus comentários, compartilhe este artigo!
Por vezes desejará não enviar a fonte de dados junto com o gráfico para um Slide que lhe solicitaram.
Talvez deseje enviar uma tabela, um relatório, partes de um Balanced Scorecard, um Dashboards ou um Scorecards, ou mesmo um conjunto deKPIs, sem que estes sejam alterados por quem recebê-los.Criar um informativo regular, parte de um relatório, que envia via MS Outlook, comentários dosrelatórios, agregando conteúdo analítico e não apenas gráficos e dados estáticos para o público alvo.
Com os recursos abaixo alistados, poderá enviar somente as imagens, como se tirasse uma foto e colasse no Slide, num documento MS Word, num e-mail e até mesmo no Photoshop (há!).
Chega! Essas são apenas algumas das possibilidades...Pensem em outras...
- CÓDIGO:
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
- CÓDIGO:
ActiveChart.CopyPicture Appearance:=xlScreen, Format:=xlPicture
- CÓDIGO:
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
- CÓDIGO:
Worksheets("Nome da pasta").ChartObjects(1).Chart.CopyPictureAppearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
- CÓDIGO:
Worksheets("Nome da pasta").Range("B11:AF25").CopyPicture Appearance:=xlScreen, Format:=xlPicture
- CÓDIGO:
Sub GraficoToPowerPoint()
Dim objPPT As Object
Dim objPrs As Object
Dim shtTemp As Worksheet
Dim chtTemp As ChartObject
Dim intSlide As Integer
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.presentations.Open ThisWorkbook.Path & "\Dashboard_Bernardes.ppt"
objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
For Each shtTemp In ThisWorkbook.Worksheets
For Each chtTemp In shtTemp.ChartObjects
intSlide = intSlide + 1
chtTemp.CopyPicture
If intSlide > objPPT.presentations(1).Slides.Count Then
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.presentations(1).Slides.Add(Index:=intSlide, Layout:=1).SlideIndex
End If
objPPT.ActiveWindow.View.Paste
Next
Next
objPPT.presentations(1).Save
objPPT.Quit
Set objPrs = Nothing
Set objPPT = Nothing
End Sub
- CÓDIGO:
Sub GraficoRange_TO_Powerpoint()
Dim objPPT As Object
Dim objPrs As Object
Dim objSld As Object
Dim shtTemp As Object
Dim chtTemp As ChartObject
Dim objShape As Shape
Dim objGShape As Shape
Dim intSlide As Integer
Dim blnCopy As Boolean
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Add
objPPT.ActiveWindow.ViewType = 1
For Each shtTemp In ThisWorkbook.Sheets
blnCopy = False
If shtTemp.Type = xlWorksheet Then
For Each objShape In shtTemp.Shapes
blnCopy = False
If objShape.Type = msoGroup Then
For Each objGShape In objShape.GroupItems
If objGShape.Type = msoChart Then
blnCopy = True
Exit For
End If
Next
End If
If objShape.Type = msoChart Then blnCopy = True
If blnCopy Then
intSlide = intSlide + 1
objShape.CopyPicture
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Next
If Not blnCopy Then
intSlide = intSlide + 1
shtTemp.UsedRange.CopyPicture
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Else
intSlide = intSlide + 1
shtTemp.CopyPicture
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
End If
Next
Set objPrs = Nothing
Set objPPT = Nothing
End Sub
- CÓDIGO:
Sub RangeUsado_TO_Powerpoint()
Dim objPPT As Object
Dim shtTemp As Object
Dim intSlide As Integer
Set objPPT = CreateObject("Powerpoint.application")
objPPT.Visible = True
objPPT.Presentations.Open ThisWorkbook.Path & "\Bernardes.ppt"
objPPT.ActiveWindow.ViewType = 1
For Each shtTemp In ThisWorkbook.Sheets
shtTemp.Range("A1", shtTemp.UsedRange).CopyPicture xlScreen, xlPicture
intSlide = intSlide + 1
objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.ActivePresentation.Slides.Add(Index:=objPPT.ActivePresentation.Slides.Count + 1, Layout:=12).SlideIndex
objPPT.ActiveWindow.View.Paste
With objPPT.ActiveWindow.View.Slide.Shapes(objPPT.ActiveWindow.View.Slide.Shapes.Count)
.Left = (.Parent.Parent.SlideMaster.Width - .Width) / 2
End With
Next
Set objPPT = Nothing
End Sub