GRAFICOS NO EXCEL URGENTE
Preciso de exemplos de como gerar gráficos no excel do VB. Só consegui o exemplo do Marcoratti e não me serviu. Peço por favor me envie com urgência.
Alegon,
Segue uma rotina para vc estudar...
Set obGrafico = Sheets("Grafico")
'apaga series do grafico
i = obGrafico.SeriesCollection.Count
Do While i > 0
obGrafico.SeriesCollection(i).Delete
i = i - 1
Loop
obGrafico.SizeWithWindow = True
For Itens = 1 To 7
If Worksheets(Planilha).Cells(5, Itens * 2).Value <> 0 Or Itens = 7 Then
'string1 = string1 & obListGraf.List(PosicaoSelecao) & Chr(13)
PosicaoInicio = "$" & Trim(Chr(Itens * 2 + 64)) & _
"$" & Trim(Str(5))
PosicaoFim = "$" & Trim(Chr(Itens * 2 + 64)) & _
"$" & Trim(Str(Worksheets(Planilha).Cells(1, 14).Value + 4))
Set obRange = Worksheets(Planilha).Range(PosicaoInicio & ":" & PosicaoFim)
'inclue nova serie no grafico
obGrafico.SeriesCollection.Add Source:=obRange, _
Rowcol:=xlColumns, SeriesLabels:=False, CategoryLabels:=False, Replace:=False
Dim X As Integer
X = obGrafico.SeriesCollection.Count
Cor = Itens + 3
If Itens = 7 Then Cor = 3 'Vermelho
If Itens = 6 Then Cor = 1 'Preto
'Definicao de como sera mostrada a serie
With obGrafico.SeriesCollection(X)
' If Itens = 7 Then
' .ChartType = xlArea 'Tipo do Grafico
' .Interior.ColorIndex = 40
' .Interior.PatternColorIndex = 19
' .Interior.Pattern = 18
' .Fill.PresetTextured PresetTexture:=msoTextureWovenMat
' Else
' .ChartType = xlLine 'Tipo do Grafico
' End If
.Border.ColorIndex = Cor 'cor do grafico
.Border.Weight = xlMedium 'padrao da linha
.Border.LineStyle = xlContinuous 'Tipo de linha
.Name = Sheets(Planilha).Cells(2, Itens * 2 - 1).Value 'Coloca nome na serie
.DataLabels.Delete
'.ApplyDataLabels Type:=xlDataLabelsShowNone, AutoText:=True, LegendKey:=False
End With
obGrafico.PlotArea.Border.ColorIndex = xlAutomatic
End If
Next Itens
PosicaoInicio = "$A$5"
PosicaoFim = "$A$" & Trim(Str(Worksheets(Planilha).Cells(1, 14).Value + 4))
Set obRange = Worksheets(Planilha).Range(PosicaoInicio & ":" & PosicaoFim)
obGrafico.SeriesCollection(1).XValues = obRange
With obGrafico
.HasTitle = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True
End With
MaiorGanho = "Maior Valor: " & CStr(Format(Worksheets(Planilha).Cells(2, 16).Value, "###,###.##"))
MaiorPrejuizo = "Menor Valor: " & CStr(Format(Worksheets(Planilha).Cells(3, 16).Value, "###,###.##"))
obGrafico.ChartTitle.Characters.Text = _
"Titulo do grafico" _
+ Chr(13) + MaiorValor& " / " & MenorValor
obGrafico.Axes(xlValue).AxisTitle.Characters.Text = _
"texto eixo X"
obGrafico.Axes(xlCategory).AxisTitle.Characters.Text = _
"Texto eixo X"
obGrafico.Legend.Position = xlBottom
obGrafico.Axes(xlCategory).TickLabels.Orientation = xlAutomatic
obGrafico.Activate
Segue uma rotina para vc estudar...
Set obGrafico = Sheets("Grafico")
'apaga series do grafico
i = obGrafico.SeriesCollection.Count
Do While i > 0
obGrafico.SeriesCollection(i).Delete
i = i - 1
Loop
obGrafico.SizeWithWindow = True
For Itens = 1 To 7
If Worksheets(Planilha).Cells(5, Itens * 2).Value <> 0 Or Itens = 7 Then
'string1 = string1 & obListGraf.List(PosicaoSelecao) & Chr(13)
PosicaoInicio = "$" & Trim(Chr(Itens * 2 + 64)) & _
"$" & Trim(Str(5))
PosicaoFim = "$" & Trim(Chr(Itens * 2 + 64)) & _
"$" & Trim(Str(Worksheets(Planilha).Cells(1, 14).Value + 4))
Set obRange = Worksheets(Planilha).Range(PosicaoInicio & ":" & PosicaoFim)
'inclue nova serie no grafico
obGrafico.SeriesCollection.Add Source:=obRange, _
Rowcol:=xlColumns, SeriesLabels:=False, CategoryLabels:=False, Replace:=False
Dim X As Integer
X = obGrafico.SeriesCollection.Count
Cor = Itens + 3
If Itens = 7 Then Cor = 3 'Vermelho
If Itens = 6 Then Cor = 1 'Preto
'Definicao de como sera mostrada a serie
With obGrafico.SeriesCollection(X)
' If Itens = 7 Then
' .ChartType = xlArea 'Tipo do Grafico
' .Interior.ColorIndex = 40
' .Interior.PatternColorIndex = 19
' .Interior.Pattern = 18
' .Fill.PresetTextured PresetTexture:=msoTextureWovenMat
' Else
' .ChartType = xlLine 'Tipo do Grafico
' End If
.Border.ColorIndex = Cor 'cor do grafico
.Border.Weight = xlMedium 'padrao da linha
.Border.LineStyle = xlContinuous 'Tipo de linha
.Name = Sheets(Planilha).Cells(2, Itens * 2 - 1).Value 'Coloca nome na serie
.DataLabels.Delete
'.ApplyDataLabels Type:=xlDataLabelsShowNone, AutoText:=True, LegendKey:=False
End With
obGrafico.PlotArea.Border.ColorIndex = xlAutomatic
End If
Next Itens
PosicaoInicio = "$A$5"
PosicaoFim = "$A$" & Trim(Str(Worksheets(Planilha).Cells(1, 14).Value + 4))
Set obRange = Worksheets(Planilha).Range(PosicaoInicio & ":" & PosicaoFim)
obGrafico.SeriesCollection(1).XValues = obRange
With obGrafico
.HasTitle = True
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True
End With
MaiorGanho = "Maior Valor: " & CStr(Format(Worksheets(Planilha).Cells(2, 16).Value, "###,###.##"))
MaiorPrejuizo = "Menor Valor: " & CStr(Format(Worksheets(Planilha).Cells(3, 16).Value, "###,###.##"))
obGrafico.ChartTitle.Characters.Text = _
"Titulo do grafico" _
+ Chr(13) + MaiorValor& " / " & MenorValor
obGrafico.Axes(xlValue).AxisTitle.Characters.Text = _
"texto eixo X"
obGrafico.Axes(xlCategory).AxisTitle.Characters.Text = _
"Texto eixo X"
obGrafico.Legend.Position = xlBottom
obGrafico.Axes(xlCategory).TickLabels.Orientation = xlAutomatic
obGrafico.Activate
Cara, me desculpe mas sou um iniciante e não consegui andar com seu exemplo. Meu negócio é o seguinte, possuo a seguinte planilha abaixo :
Perguntas 7a.serie 8a.serie
Questão 1 3,27 1,27
Questão 2 3,29 1,28
Questão 3 4,25 2,2
Questão 4 4,2 1,28
Preciso de um gráfico comparando o percentual de cada série em cada questão, então serião 2 barras verticais para cada pergunta, ok ?
Como faço ?
Grato pela atenção
Perguntas 7a.serie 8a.serie
Questão 1 3,27 1,27
Questão 2 3,29 1,28
Questão 3 4,25 2,2
Questão 4 4,2 1,28
Preciso de um gráfico comparando o percentual de cada série em cada questão, então serião 2 barras verticais para cada pergunta, ok ?
Como faço ?
Grato pela atenção
Vou ver se consigo fazer pra vc e te passo neste final de semana
Blz. amigo, fico esperando porque estou ralando o fim de semana pra entregar um serviço na segunda e só falta a geração destes gráficos e estou apanhando !
Alegon,
Segue a planilha pra vc estudar.
Segue a planilha pra vc estudar.
Tá só que tenho que fazer um programa para gerar as planilhas, fazer o gráfico no excel é mole, não consegui foi fazer o fonte pra gera-lo.
Alegon,
Estou meio sem tempo pra te ajudar.... Tambem tenho trabalhos pra entregar na segunda. Tenta usar o gravador de macro do excel. Com ele vc tera uma boa noção de como o excel funciona e vai ficar facil fazer sua macro.
Acho que com ele vc consegue resolver seu problema.
Estou meio sem tempo pra te ajudar.... Tambem tenho trabalhos pra entregar na segunda. Tenta usar o gravador de macro do excel. Com ele vc tera uma boa noção de como o excel funciona e vai ficar facil fazer sua macro.
Acho que com ele vc consegue resolver seu problema.
Blz. valeu !
Tópico encerrado , respostas não são mais permitidas