USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  Grafico do VB Para o Excel
Kartman
não registrado
Postada em 04/04/2007 12:37 hs   
Gente, bom dia a todos, estou com um pequeno problema, a minha empresa me pediu para gerar um gráfico com dados do VB para o Excel, até ae nenhum problema, fiz isso mole-mole... porem não consigo editar as legendas do gráfico, alguem sabe a função ou sintaxe que faz isso ?

é tipo assim...

fica aparecendo sequencia 1, sequencia 2, sequencia 3 ...
eu quero que fique aparecendo Abacaxi, Uva, Pera ...

Deu para entender, se alguem souber por favor poste aqui, estou 2 dias ja pesquisando... desde já agradeço.



Alexandre
     
ghost_jlp
 Pontos: 2843 Pontos: 2843 Pontos: 2843 Pontos: 2843
SÃO PAULO
SP - BRASIL
Postada em 05/04/2007 02:28 hs            
É bem simples colega!
Olha, vou pegar o exemplo do site do macoratti.net:
 
Dim oBook As Object  ' workbook
Dim oSheet As Object ' Worksheet
Dim oChart As Object ' grafico Excel
Dim iRow As Integer  ' variavel para a linha atual
Dim iCol As Integer  ' variavel para coluna atual
Const cNumCols = 6   ' numero de pontos em cada serie
Const cNumRows = 2   ' Numero de series

ReDim aTemp(1 To cNumRows, 1 To cNumCols)
'inicia o Excel e cria um novo workbook
Set oXL = CreateObject("Excel.application")
Set oBook = oXL.Workbooks.Add
Set oSheet = oBook.Worksheets.Item(1)
' Inclua alguns dados nas células para as duas series
aTemp(1, 1) = "uva"
aTemp(2, 1) = "pera"
 
Randomize Now()
For iRow = 1 To cNumRows
  For iCol = 2 To cNumCols
    aTemp(iRow, iCol) = Int(Rnd * 50) + 1
  Next iCol
Next iRow
oSheet.Range("A1").Resize(cNumRows, cNumCols).Value = aTemp
'Inclui um objeto chart para o primeiro worksheet
Set oChart = oSheet.ChartObjects.Add(50, 40, 300, 200).Chart
oChart.SetSourceData Source:=oSheet.Range("A1").Resize(cNumRows, cNumCols)

' torna o Excel Visivel
oXL.Visible = True
oXL.UserControl = True
 
A diferença é a parte destacada em vermelho... só disse que a primeira coluna são as seqüências e o restante são dados... lembra que no excel vc seleciona todos os dados, inclusive as descrições dos valores, e já monta o gráfico a partir daí? É a mesma coisa...
 
qq dúvida postae
 
at+
 
obs.:  Se quiser testar coloca o código acima num botão e roda... :) 
     
Kartman
não registrado
Postada em 05/04/2007 11:33 hs   
Po colega, continuei boiando, sinceramente, não entendi, e tambem, não consegui colocar em prática isso no meu projeto, coloquei o codigo aqui em baixo da parte da geração para você me da uma luz.... Obrigadão

' ============================== < GERAÇÃO EXCEL > ==============================
Dim objExcel As Object     ' Excel Application
    Dim objBook As Object      ' Excel WorkBook
    Dim objSheet As Object     ' Excel WorkSheet
    
    Set objExcel = CreateObject("excel.application") 'Inicia a sessão do Excel
    Set objBook = objExcel.Workbooks.Add             'Adiciona a Workbook (Arquivo)
    Set objSheet = objBook.Worksheets.Item(1)        'Seleciona a Sheet (Plano)
    objExcel.Application.Visible = True

    LINHA = 1
    coluna = 1
    
    With objExcel.Application
        .Cells(LINHA, 2).Value = "PERGUNTA 1": .Cells(1, 1).Interior.ColorIndex = 1: .Cells(1, 1).Font.ColorIndex = 2: .Cells(1, 1).Font.Bold = True
        .Cells(LINHA, 2).Value = "PERGUNTA 1": .Cells(LINHA, 2).Interior.ColorIndex = 1: .Cells(LINHA, 2).Font.ColorIndex = 2: .Cells(LINHA, 2).Font.Bold = True
        .Cells(LINHA, 3).Value = "PERGUNTA 2": .Cells(LINHA, 3).Interior.ColorIndex = 1: .Cells(LINHA, 3).Font.ColorIndex = 2: .Cells(LINHA, 3).Font.Bold = True
        .Cells(LINHA, 4).Value = "PERGUNTA 3": .Cells(LINHA, 4).Interior.ColorIndex = 1: .Cells(LINHA, 4).Font.ColorIndex = 2: .Cells(LINHA, 4).Font.Bold = True
        .Cells(LINHA, 5).Value = "PERGUNTA 4": .Cells(LINHA, 5).Interior.ColorIndex = 1: .Cells(LINHA, 5).Font.ColorIndex = 2: .Cells(LINHA, 5).Font.Bold = True
        .Cells(LINHA, 6).Value = "PERGUNTA 5": .Cells(LINHA, 6).Interior.ColorIndex = 1: .Cells(LINHA, 6).Font.ColorIndex = 2: .Cells(LINHA, 6).Font.Bold = True
    End With
    
    
    With objExcel.Application
        .Cells(2, coluna).Value = "RUIM": .Cells(2, coluna).Interior.ColorIndex = 1: .Cells(2, coluna).Font.ColorIndex = 2: .Cells(2, coluna).Font.Bold = True
        .Cells(3, coluna).Value = "REGULAR": .Cells(3, coluna).Interior.ColorIndex = 1: .Cells(3, coluna).Font.ColorIndex = 2: .Cells(3, coluna).Font.Bold = True
        .Cells(4, coluna).Value = "BOM": .Cells(4, coluna).Interior.ColorIndex = 1: .Cells(4, coluna).Font.ColorIndex = 2: .Cells(4, coluna).Font.Bold = True
        .Cells(5, coluna).Value = "OTIMO": .Cells(5, coluna).Interior.ColorIndex = 1: .Cells(5, coluna).Font.ColorIndex = 2: .Cells(5, coluna).Font.Bold = True
        .Cells(6, coluna).Value = "EXCELENTE": .Cells(6, coluna).Interior.ColorIndex = 1: .Cells(6, coluna).Font.ColorIndex = 2: .Cells(6, coluna).Font.Bold = True
    End With
    
    
    a = "A"
    b = "B"
    c = "C"
    d = "D"
    e = "E"
    f = "F"
    
    i = 2

        With objExcel.Application
            .Cells(i, 2).Value = RESPARUIM
            If RESPARUIM = "" Then
                .Cells(i, 2).Value = 0
            End If
            
            .Cells(i, 3).Value = RESPBRUIM
            If RESPBRUIM = "" Then
                .Cells(i, 3).Value = 0
            End If
            
            .Cells(i, 4).Value = RESPCRUIM
            If RESPCRUIM = "" Then
                .Cells(i, 4).Value = 0
            End If
            
            .Cells(i, 5).Value = RESPDRUIM
            If RESPDRUIM = "" Then
                .Cells(i, 5).Value = 0
            End If
            
            .Cells(i, 6).Value = RESPERUIM
            If RESPERUIM = "" Then
                .Cells(i, 6).Value = 0
            End If
        End With

    i = 3
    
        With objExcel.Application
            .Cells(i, 2).Value = RESPAREGULAR
            If RESPAREGULAR = "" Then
                .Cells(i, 2).Value = 0
            End If
            
            .Cells(i, 3).Value = RESPBREGULAR
            If RESPBREGULAR = "" Then
                .Cells(i, 3).Value = 0
            End If
            .Cells(i, 4).Value = RESPCREGULAR
            If RESPCREGULAR = "" Then
                .Cells(i, 4).Value = 0
            End If
            
            .Cells(i, 5).Value = RESPDREGULAR
            If RESPDREGULAR = "" Then
                .Cells(i, 5).Value = 0
            End If
            
            .Cells(i, 6).Value = RESPEREGULAR
            If RESPEREGULAR = "" Then
                .Cells(i, 6).Value = 0
            End If
        End With

    
    i = 4
    
        With objExcel.Application
            .Cells(i, 2).Value = RESPABOM
            If RESPABOM = "" Then
                .Cells(i, 2).Value = 0
            End If
            
            .Cells(i, 3).Value = RESPBBOM
            If RESPBBOM = "" Then
                .Cells(i, 3).Value = 0
            End If
            
            .Cells(i, 4).Value = RESPCBOM
            If RESPCBOM = "" Then
                .Cells(i, 4).Value = 0
            End If
            
            .Cells(i, 5).Value = RESPDBOM
            If RESPDBOM = "" Then
                .Cells(i, 5).Value = 0
            End If
            
            .Cells(i, 6).Value = RESPEBOM
            If RESPEBOM = "" Then
                .Cells(i, 6).Value = 0
            End If
        End With
    
    i = 5
    
        With objExcel.Application
            .Cells(i, 2).Value = RESPAOTIMO
            If RESPAOTIMO = "" Then
                .Cells(i, 2).Value = 0
            End If
            
            .Cells(i, 3).Value = RESPBOTIMO
            If RESPBOTIMO = "" Then
                .Cells(i, 3).Value = 0
            End If
            
            .Cells(i, 4).Value = RESPCOTIMO
            If RESPCOTIMO = "" Then
                .Cells(i, 4).Value = 0
            End If
            
            .Cells(i, 5).Value = RESPDOTIMO
            If RESPDOTIMO = "" Then
                .Cells(i, 5).Value = 0
            End If
            
            .Cells(i, 6).Value = RESPEOTIMO
            If RESPEOTIMO = "" Then
                .Cells(i, 6).Value = 0
            End If
        End With

    
    i = 6
    
        With objExcel.Application
            .Cells(i, 2).Value = RESPAEXCELENTE
            If RESPAEXCELENTE = "" Then
                .Cells(i, 2).Value = 0
            End If
            
            .Cells(i, 3).Value = RESPBEXCELENTE
            If RESPBEXCELENTE = "" Then
                .Cells(i, 3).Value = 0
            End If
            
            .Cells(i, 4).Value = RESPCEXCELENTE
            If RESPCEXCELENTE = "" Then
                .Cells(i, 4).Value = 0
            End If
            
            .Cells(i, 5).Value = RESPDEXCELENTE
            If RESPDEXCELENTE = "" Then
                .Cells(i, 5).Value = 0
            End If
            
            .Cells(i, 6).Value = RESPEEXCELENTE
            If RESPEEXCELENTE = "" Then
                .Cells(i, 6).Value = 0
            End If
        End With

        objExcel.Application.Cells.Columns.AutoFit
        objExcel.Application.Cells.Borders.LineStyle = 1
        objExcel.Application.Cells.Borders.ColorIndex = 15
        
        Range("B2:F6").Select
        Set Exlc = objExcel.Charts.Add
        
        Exlc.Legend.Position = xlLegendPositionBottom

        Exlc.HasTitle = True
        Exlc.ChartTitle.Text = Combo1.Text
        Exlc.HasLegend = True
        
        objExcel.Save (Combo1.Text)
                
        Set objSheet = Nothing
        Set objBook = Nothing
        Set objExcel = Nothing
        Set Exlc = Nothing

' ==============================

Não comentei o código por ele em si ser de bem facil visualização, RESPARUIM, RESPBRUIM, RESPCRUIM .... SÃO VARIAVEIS DO SISTEMA !!!!!


Desde Já Agradeço .
Alexandre
     
Kartman
não registrado
Postada em 05/04/2007 11:40 hs   
outra coisa... ate consegui fazer seu exemplo... funcionou sim perfeitamente, apesar de estar faltando a declaração de uma variavel ...

Dim OXL As Object


mas tudo certo ...
soh que nesse meu projeto ainda não consegui entender..
     
Kartman
não registrado
Postada em 05/04/2007 13:02 hs   
OPA !!!!!
CONSEGUI CARA, OBRIGADÃO PELA SUA AJUDA, MODIFIQUEI MEU CODIGO PARA QUE FICASSE PARECIDO COM O SEU E DEU CERTO ... MUITO OBRIGADO MESMO, AGORA UMA ULTIMA DUVIDA, VOCE SABE SE TEM ALGUMA OPÇÃO QUE EU SALVE O EXCEL, QUANDO ELE TERMINA DE GERAR O GRAFICO SEM PERGUNTAR SE QUER SALVAR COM OUTRO NOME.

PORQUE EU USEI ASSIM .

OXL.SAVE(COMBO1.TEXT)

SO QUE SEMPRE ELE SALVA E PREGUNTA SE QUER SALVAR UMA COPIA COM OUTRO NOME.. OBRIGADAO MESMO
     
ghost_jlp
 Pontos: 2843 Pontos: 2843 Pontos: 2843 Pontos: 2843
SÃO PAULO
SP - BRASIL
Postada em 05/04/2007 15:32 hs            
No momento tô no cliente e não tem vb, qdo chegar em casa, se algum colega não der a solução antes, eu dou uma olhada... de cabeça não lembro!Emoções
     
Página(s): 1/2      PRÓXIMA »


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



CyberWEB Network Ltda.    © Copyright 2000-2025   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site 		Topo da página