cria gráficos excel em folha separada usando vba

Question

cria gráficos excel em folha separada usando vba

#1 resposta do (0 votos)

0

No Excel 2016, estou tentando gravar um sub-vba que usa uma planilha contendo alguns dados e cria uma nova planilha que será preenchida com gráficos que usam os dados da planilha original.

Eu gravei algumas macros e tentei usar isso para escrever meu código. Até agora, consegui criar os gráficos na mesma folha que os dados, todos empilhados uns sobre os outros.

Eu gostaria que os gráficos preenchessem uma página separada e os espaçassem de alguma forma, para que não estivessem bloqueando um ao outro. Eu acredito que isso envolveria não usar o ActiveSheet que o gravador de macro geralmente usa.

Eu postei meu código abaixo e gostaria de receber ajuda.

Private Sub CommandButton2_Click()
'Measure A pair for A signal
Range("A:A,B:B,C:C,D:D,E:E").Select
    Range("E1").Activate
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range( _
        "TEST!$B:$B,TEST!$C:$C,TEST!$D:$D,TEST!$E:$E")
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "=TEST!$A2:$A1179"
'Measure B pair for A signal
Range("A:A,B:B,C:C,D:D,E:E").Select
    Range("E1").Activate
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range( _
        "TEST!$F:$F,TEST!$G:$G,TEST!$H:$H,TEST!$I:$I")
    Application.CutCopyMode = False
    Application.CutCopyMode = False
    ActiveChart.FullSeriesCollection(1).XValues = "=TEST!$A2:$A1179"
End Sub

A planilha que contém os dados é chamada de "TESTE"

microsoft-excel microsoft-excel-2016 charts vba

por Kyle Jones 26.06.2018 / 15:39

1 resposta

Tags microsoft-excel microsoft-excel-2016 charts vba

Gerenciamento de direitos SSHFS no ambiente de desenvolvimento virtualizado do Debian 9 Meu cursor tem uma parte de uma duplicata que a segue ao redor

score 0 · Answer 1

Não tenho certeza se isso seria útil para qualquer pessoa, mas aqui está meu código final que acabei com:

Private Sub GraphButton1_Click()

Dim lngcount As Long
Dim filePath As String
Dim file_array As New Collection
'Open the file dialog'
With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Show

    'Display paths of each file selected'
    For lngcount = 1 To .SelectedItems.Count
        filePath = .SelectedItems(lngcount)
        If Dir(filePath) <> "" Then
            Workbooks.Open (filePath)
            file_array.Add filePath
        End If
    Next lngcount
End With

Dim f As Variant
For Each f In file_array


'fileName is filename plus extension'
Filename = Dir(f)

'Create Workbook Object for TEST_DATA'
Dim wb As Workbook
Set wb = Application.Workbooks(Filename)

'wsName is fileName without extension'
Dim wsName As String
wsName = Left(Filename, Len(Filename) - 4)

'Create Worksheet Object for TEST'
Dim ws As Worksheet
Set ws = wb.Worksheets(wsName)
'Add chartsheet to workbook and create Worksheet Object for chartsheet'
wb.Worksheets.Add().Name = "chartsheet"
Dim chartsheet As Worksheet
Set chartsheet = wb.Worksheets("chartsheet")

'Measure A pair for A signal'
Dim chart1 As Chart
Set chart1 = chartsheet.Shapes.AddChart2.Chart

With chart1
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$B:$B,$C:$C,$D:$D,$E:$E")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 10
End With

'Measure B pair for A signal'
Dim chart2 As Chart
Set chart2 = chartsheet.Shapes.AddChart2.Chart
With chart2
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$F:$F,$G:$G,$H:$H,$I:$I")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 10
End With

'Measure C pair for A signal'
Dim chart3 As Chart
Set chart3 = chartsheet.Shapes.AddChart2.Chart
With chart3
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$J:$J,$K:$K,$L:$L,$M:$M")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 10
End With

'Measure D pair for A signal'
Dim chart4 As Chart
Set chart4 = chartsheet.Shapes.AddChart2.Chart
With chart4
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData Source:=Sheets(wsName).Range("$N:$N,$O:$O,$P:$P,$Q:$Q")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for A signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 10
End With

'Measure B pair for B signal'
Dim chart5 As Chart
Set chart5 = chartsheet.Shapes.AddChart2.Chart
With chart5
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AN:$AN,$AO:$AO,$AP:$AP,$AQ:$AQ")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 240
End With

'Measure A pair for B signal'
Dim chart6 As Chart
Set chart6 = chartsheet.Shapes.AddChart2.Chart
With chart6
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AJ:$AJ,$AK:$AK,$AL:$AL,$AM:$AM")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 240
End With

'Measure C pair for B signal'
Dim chart7 As Chart
Set chart7 = chartsheet.Shapes.AddChart2.Chart
With chart7
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AR:$AR,$AS:$AS,$AT:$AT,$AU:$AU")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 240
End With

'Measure D pair for B signal'
Dim chart8 As Chart
Set chart8 = chartsheet.Shapes.AddChart2.Chart
With chart8
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$AV:$AV,$AW:$AW,$AX:$AX,$AY:$AY")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for B signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 240
End With

'Measure C pair for C signal'
Dim chart9 As Chart
Set chart9 = chartsheet.Shapes.AddChart2.Chart
With chart9
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$BZ:$BZ,$CA:$CA,$CB:$CB,$CC:$CC")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 470
End With

'Measure A pair for C signal'
Dim chart10 As Chart
Set chart10 = chartsheet.Shapes.AddChart2.Chart
With chart10
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$BR:$BR,$BS:$BS,$BT:$BT,$BU:$BU")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 470
End With

'Measure B pair for C signal'
Dim chart11 As Chart
Set chart11 = chartsheet.Shapes.AddChart2.Chart
With chart11
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$BV:$BV,$BW:$BW,$BX:$BX,$BY:$BY")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 470
End With

'Measure D pair for C signal'
Dim chart12 As Chart
Set chart12 = chartsheet.Shapes.AddChart2.Chart
With chart12
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$CD:$CD,$CE:$CE,$CF:$CF,$CG:$CG")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for C signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 470
End With

'Measure D pair for D signal'
Dim chart13 As Chart
Set chart13 = chartsheet.Shapes.AddChart2.Chart
With chart13
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$DL:$DL,$DM:$DM,$DN:$DN,$DO:$DO")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "D pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 10
    .ChartArea.Top = 700
End With

'Measure A pair for D signal'
Dim chart14 As Chart
Set chart14 = chartsheet.Shapes.AddChart2.Chart
With chart14
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$CZ:$CZ,$DA:$DA,$DB:$DB,$DC:$DC")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "A pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 380
    .ChartArea.Top = 700
End With

'Measure B pair for D signal'
Dim chart15 As Chart
Set chart15 = chartsheet.Shapes.AddChart2.Chart
With chart15
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$DD:$DD,$DE:$DE,$DF:$DF,$DG:$DG")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "B pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 750
    .ChartArea.Top = 700
End With

'Measure C pair for D signal'
Dim chart16 As Chart
Set chart16 = chartsheet.Shapes.AddChart2.Chart
With chart16
    .Location Where:=xlLocationAsObject, Name:="chartsheet"
    .ChartType = xlLine
    .SetSourceData 
Source:=Sheets(wsName).Range("$DH:$DH,$DI:$DI,$DJ:$DJ,$DK:$DK")
    .FullSeriesCollection(1).XValues = Sheets(wsName).Range("$A2:$A1179")
    .HasTitle = True
    .ChartTitle.Text = "C pair for D signal"
    .HasLegend = True
    .ChartArea.Left = 1120
    .ChartArea.Top = 700
End With



Next f

End Sub

Obviamente, isso provavelmente não será diretamente aplicável aos projetos de outras pessoas, mas esperamos que partes dele possam ser úteis, já que o código inclui a abertura de arquivos e a criação de objetos para as planilhas nesses arquivos