none
Do Control Listbox para a Folha de Cálculo. RRS feed

  • Pergunta

  • Amigos, Boa Tarde.

    Tenho uma Listbox com 3 colunas e pretendia copiar os dados para a folha de cálculo, com o objetivo de construir um gráfico, que posteriormente passará para o Formulário.

    A rotina que estou a tentar fazer funcionar é a que se segue, mas embora não me dê qualquer erro, também não me transfere os dados para a folha.

    Sub Copiar_ListBox_Para_Planilha(ByVal NomePlanilhaDestino As String, ByRef listBoxControl As MSForms.ListBox)
        Dim iListCount As Integer, iColCount As Integer, iColListCount As Integer
        Dim iRow As Integer
        Dim linhaInicial As Integer
        Dim planilhaDestino As Worksheet
     
        Set planilhaDestino = ThisWorkbook.Worksheets("Folha4")
        linhaInicial = planilhaDestino.Cells(65536, 1).End(xlUp).Row + 1
     
        If listBoxControl.RowSource <> "" Then
            iColListCount = Range(listBoxControl.RowSource).Columns.Count
        Else
            iColListCount = listBoxControl.ColumnCount - 1
        End If
     
        If listBoxControl.ColumnHeads Then
            iRow = 1
        End If
     
        'faz o loop para todos os itens do ListBox
        For iListCount = 0 To listBoxControl.ListCount - 1
            If listBoxControl.Selected(iListCount) = True Then
                listBoxControl.Selected(iListCount) = False
                iRow = iRow + 1
                'faz o loop pelas colunas
                For iColCount = 0 To iColListCount - 1
                    'copia os dados do controle para a planilha
                    planilhaDestino.Cells(iRow, iColCount + 1).Value = listBoxControl.List(iListCount, iColCount)
                Next iColCount
            End If
        Next iListCount
     
    End Sub

    A Listbox em causa é a Listbox3 e a folha para onde os dados devem passar é a "Folha4".

    A disposição dos dados exibidos na Listbox e a seguinte:

             A62 23 19,35%

    T01 12 10,03%

    Y86  6  8,51%

    Podem ajudar-me a resolver este dilema? É que ... até ao momento, nenhuma rotina tem resolvido o meu problema.

    O procedimento colocado em cima está colocado num Módulo e é chamado pelo comando:

    Call Copiar_ListBox_Para_Planilha("Data Transfer Sheet", Me.ListBox3)

    Muito agradecido, pela ajuda que puderem prestar.

    Cumprimentos

    M_A_L


    • Editado M_A_S_L quarta-feira, 15 de janeiro de 2014 17:00
    quarta-feira, 15 de janeiro de 2014 16:45

Respostas

  • Sugiro que os parâmetros de sua função sejam um objeto Range e um objeto ListBox.

    Veja se o exemplo a seguir te ajuda a resolver o problema. Para usa-lo, Crie um formulário em branco com uma caixa de listagem chamada ListBox1:

    Private Sub UserForm_Click()
      Copiar_ListBox_Para_Planilha ThisWorkbook.Worksheets("Plan1").Range("A1"), Me.ListBox1
    End Sub
    
    Sub Copiar_ListBox_Para_Planilha(rng As Excel.Range, _
                                     lbo As MSForms.ListBox)
      rng.Resize(lbo.ListCount, lbo.ColumnCount).Value = lbo.List
    End Sub
    
    
    Private Sub UserForm_Initialize()
      With Me.ListBox1
        .ColumnCount = 3
        .AddItem
        .AddItem
        .AddItem
        .List(0, 0) = "lin 1, col1"
        .List(0, 1) = "lin 1, col2"
        .List(0, 2) = "lin 1, col3"
        .List(1, 0) = "lin 2, col1"
        .List(1, 1) = "lin 2, col2"
        .List(1, 2) = "lin 2, col3"
        .List(2, 0) = "lin 3, col1"
        .List(2, 1) = "lin 3, col2"
        .List(2, 2) = "lin 3, col3"
      End With
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:03
    quarta-feira, 15 de janeiro de 2014 21:57
    Moderador
  • Qualifique os objetos que utiliza. Se você usar Cells(...) ao invés de Planilha.Cells, o Excel irá considerar a planilha ativa. O nome da técnica de representar o objeto pai de um objeto é qualificação.

    Indentei (veja na internet que é indentação), corrigi o laço de excluir linhas (que deve ser do fim ao início senão não apaga duas linhas consecutivas) e pus em negrito as qualificações.

    Outra sugestão: em laços, ao invés de usar Range("A" & Linha), prefira usar Cells(Linha, "A").

    Private Sub CheckBox17_Click()
      Dim DELRow As Long, DELline As Long
      Dim wks As Excel.Worksheet
      
      Set wks = ThisWorkbook.Sheets("Folha4")
      DELline = wks.Cells(wks.Cells.Rows.Count, 1).End(xlUp).Row
      'Laços para excluir linhas devem ser do fim ao início
      For DELRow = DELline To 2 Step -1
        If wks.Cells(DELRow, "A").Value <> "" Then
          wks.Rows(DELRow).Delete
        End If
      Next DELRow
      If CheckBox17.Value = True Then
        If CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False _
        And CheckBox4.Value = False And CheckBox5.Value = False And CheckBox6.Value = False _
        And CheckBox7.Value = False And CheckBox8.Value = False Then
          MsgBox "NENHUMA CONSULTA FOI SELECIONADA." & vbNewLine & vbNewLine & vbNewLine _
          & Space(12) & "SELECIONE UMA CONSULTA."
          CheckBox17.Value = False
          Exit Sub
        Else
          Copiar_ListBox_Folha wks.Range("A1"), Me.ListBox3
          UserForm1_GRAFICO.Show
        End If
      Else
        CheckBox17.Value = False
      End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:02
    quinta-feira, 16 de janeiro de 2014 22:34
    Moderador
  • Boa tarde, Felipe.

    Qualquer coisa não funciona bem e não descortino o que é.

    Quanto à sua rotina, penso que funciona bem, depois das correções que gentilmente efetuou, mas a rotina dá-me erro na linha

          UserForm1_GRAFICO.Show

    e como tal, não consigo testá-lo por completo.

    Penso que este erro advém do código inserido no "Initialize" deste Formulário, que gera o gráfico e o coloca no formulário.

    Porém este gráfico é um gráfico criado na folha4, que apenas se altera, modificando os dados inseridos, não é um gráfico criado pelo VBA. 

    Acontece que ao eliminar as linhas, até à linha 2 ou 3, o gráfico também é eliminado e daí poderá também resultar este erro.

    O código associado ao formulário que exibe o gráfico é o que mostro em seguida:

    Private Sub UserForm_Initialize()
    
    Dim ArqImagem As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim GraficoCirc As Chart
    
    Set ws = ThisWorkbook.Sheets("Folha4")
    Set rng = ws.Range("A1").CurrentRegion
    
    Set GraficoCirc = ws.ChartObjects(1).Chart
    
        GraficoCirc.Parent.Width = UserForm1_GRAFICO.Image1.Width
        GraficoCirc.Parent.Height = UserForm1_GRAFICO.Image1.Height
        On Error Resume Next
        
    ArqImagem = ThisWorkbook.Path & "\GraficoCirc.jpg"
    
    GraficoCirc.Export Filename:=ArqImagem, filtername:="JPG"
    
    'carrega grágico
    Image1.Picture = LoadPicture(ArqImagem)
    
    End Sub

    O erro, 

    Run time error '1004':

    Metod 'ChartObjects' of Object '_Worksheet' failed

    O que falta aqui?

    Antes de corrigir o código, o gráfico era corretamente exibido e não desaparecia, porém com a eliminação de linhas o gráfico desaparece.

    Cumprimentos

    M_A_L



    • Editado M_A_S_L sábado, 18 de janeiro de 2014 01:17
    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:02
    sexta-feira, 17 de janeiro de 2014 17:41
  • Fiz algumaks modificações:

    Private Sub UserForm_Initialize()
      'Criando Gráfico:
      Dim cho As Excel.ChartObject
      Dim GraficoCirc As Excel.ChartObject
      Dim wks As Excel.Worksheet
      Dim lngRow As Long
      Dim lngLast As Long
      
      Set wks = ThisWorkbook.Sheets("Folha4")
      lngRow = wks.Range("A" & Rows.Count).End(xlUp).Row
      Set cho = wks.ChartObjects.Add(170, 20, 450, 250)
      With cho.Chart
        .ChartType = xl3DPieExploded
        .SetSourceData wks.Range("A1:B" & lngLast)
        .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
      End With
      'Next lngrow
      Dim ArqImagem As String
      
      Set GraficoCirc = cho
      GraficoCirc.Activate
      
      ActiveChart.Parent.Width = UserForm1_GRAFICO.Image1.Width
      ActiveChart.Parent.Height = UserForm1_GRAFICO.Image1.Height
      On Error Resume Next
    
      'exporta a imagem do gráfico para a pasta
      ArqImagem = ThisWorkbook.Path & "\GraficoCirc.JPEG"
      ActiveChart.Export Filename:=ArqImagem, filtername:="JPEG"
    
      'carrega grágico
      Image1.Picture = LoadPicture(ArqImagem)
      'elimina o gráfico criado
      
      cho.Delete
      Kill ArqImagem
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:00
    segunda-feira, 20 de janeiro de 2014 21:02
    Moderador
  • Felipe.

    Depois de muito olhar o código, cheguei a uma conclusão.

    O F8 que me indicou faz efetivamente muita falta e é uma otima ferramenta.

    Com ele desembrulhei o código de forma a que tudo bata certo, exceto a rotação.

    O lngLast faz falta para delimitar o numero de registos pois com o seu código o gráfico executava com todas as categorias. O resto. o F8, disse-me passo a passo, as linhas que deveriam ser eliminadas até chegar ao pretendido.

    E então ficou assim:

    Dim lngLast As Long
    
      Set wks = ThisWorkbook.Sheets("Folha4")
      lngRow = wks.Range("A" & Rows.Count).End(xlUp).Row
      lngLast = wks.Range("B" & Rows.Count).End(xlUp).Row
      Set cho = wks.ChartObjects.Add(170, 20, 500, 290)
      
    lngLast = 10
        If lngRow > 10 Then
    
            With cho.Chart
              .ChartType = xl3DPieExploded
              .SetSourceData wks.Range("A1:B" & lngLast)
              .SeriesCollection(1).ApplyDataLabels Type:=xlValue
              .SeriesCollection(1).DataLabels.Select
              Selection.ShowCategoryName = True
              Selection.Format.TextFrame2.TextRange.Font.Size = 16
              Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
              .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
            End With
        Else
            With cho.Chart
              .ChartType = xl3DPieExploded
              .SetSourceData wks.Range("A1:B" & lngRow)
              .SeriesCollection(1).ApplyDataLabels Type:=xlValue
              .SeriesCollection(1).DataLabels.Select
              Selection.ShowCategoryName = True
              Selection.Format.TextFrame2.TextRange.Font.Size = 16
              Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
              .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
            End With
        End If
    
    Dim ArqImagem As String

    Se puder ajudar na rotação fico agradecido.

    Se não, fico-lhe agradecido da mesma forma, pois os seus ensinamentos, foram uma mais valia para mim.

    Abraços.

    M_A_L

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:00
    terça-feira, 21 de janeiro de 2014 17:52
  • wks.Shapes(cho.Name).Chart.ChartArea.Format.ThreeD.RotationX = -50
    O que acontece nesse caso é que o gravador de macros falha, sendo a sintaxe correta para fazer o ajuste desejado o código acima.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 20:06
    sábado, 25 de janeiro de 2014 17:54
    Moderador

Todas as Respostas

  • Sugiro que os parâmetros de sua função sejam um objeto Range e um objeto ListBox.

    Veja se o exemplo a seguir te ajuda a resolver o problema. Para usa-lo, Crie um formulário em branco com uma caixa de listagem chamada ListBox1:

    Private Sub UserForm_Click()
      Copiar_ListBox_Para_Planilha ThisWorkbook.Worksheets("Plan1").Range("A1"), Me.ListBox1
    End Sub
    
    Sub Copiar_ListBox_Para_Planilha(rng As Excel.Range, _
                                     lbo As MSForms.ListBox)
      rng.Resize(lbo.ListCount, lbo.ColumnCount).Value = lbo.List
    End Sub
    
    
    Private Sub UserForm_Initialize()
      With Me.ListBox1
        .ColumnCount = 3
        .AddItem
        .AddItem
        .AddItem
        .List(0, 0) = "lin 1, col1"
        .List(0, 1) = "lin 1, col2"
        .List(0, 2) = "lin 1, col3"
        .List(1, 0) = "lin 2, col1"
        .List(1, 1) = "lin 2, col2"
        .List(1, 2) = "lin 2, col3"
        .List(2, 0) = "lin 3, col1"
        .List(2, 1) = "lin 3, col2"
        .List(2, 2) = "lin 3, col3"
      End With
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:03
    quarta-feira, 15 de janeiro de 2014 21:57
    Moderador
  • Boa tarde, Felipe.

    Embora tenha prescindido do código do evento Initialize, pois o que tenho está a funcionar bem, as outras rotinas, funcionam de forma perfeita.

    Muito Obrigado.

    Mas ... se num tipo de consulta, grava na folha cerca de 200 linhas, noutro tipo de consulta grava apenas 5 linhas e portanto, ao construir o gráfico, normalmente com as 10 maiores quantidades, o gráfico iria utilizar 5 quantidades de uma consulta que lhe não pertencem, daí a necessidade de eliminar as linhas antes de construir novo gráfico.

    Para isso estou a utilizar a rotina seguinte:

    Private Sub CheckBox17_Click()
    Dim DELRow As Long, DELline As Long
    
    DELline = Sheets("Folha4").Cells(Cells.Rows.Count, 1).End(xlUp).Row
    
     For DELRow = 2 To DELline
          If Range("Folha4!A" & DELRow).Value <> "" Then
          ActiveCell.EntireRow.Delete
          End If
     Next
          If CheckBox17.Value = True Then
    If CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False _
        And CheckBox4.Value = False And CheckBox5.Value = False And CheckBox6.Value = False _
        And CheckBox7.Value = False And CheckBox8.Value = False Then
        
    MsgBox "NENHUMA CONSULTA FOI SELECIONADA." & vbLf & vbLf & vbLf & "            SELECIONE UMA CONSULTA."
    CheckBox17.Value = False
    Exit Sub
    
    Else
    Copiar_ListBox_Folha ThisWorkbook.Worksheets("Folha4").Range("A1"), Me.ListBox3
    UserForm1_GRAFICO.Show
    End If
    Else
    CheckBox17.Value = False
    End If
    End Sub

    Mas por estranho que pareça, pelo menos para mim, em vez de eliminar os dados da "Folha4", elimina os dados da folha "DADOS".

    Pode ajudar-me por favor a descortinar a falha?

    Cumprimentos

    M_A_L



    • Editado M_A_S_L quinta-feira, 16 de janeiro de 2014 17:55
    quinta-feira, 16 de janeiro de 2014 17:53
  • Qualifique os objetos que utiliza. Se você usar Cells(...) ao invés de Planilha.Cells, o Excel irá considerar a planilha ativa. O nome da técnica de representar o objeto pai de um objeto é qualificação.

    Indentei (veja na internet que é indentação), corrigi o laço de excluir linhas (que deve ser do fim ao início senão não apaga duas linhas consecutivas) e pus em negrito as qualificações.

    Outra sugestão: em laços, ao invés de usar Range("A" & Linha), prefira usar Cells(Linha, "A").

    Private Sub CheckBox17_Click()
      Dim DELRow As Long, DELline As Long
      Dim wks As Excel.Worksheet
      
      Set wks = ThisWorkbook.Sheets("Folha4")
      DELline = wks.Cells(wks.Cells.Rows.Count, 1).End(xlUp).Row
      'Laços para excluir linhas devem ser do fim ao início
      For DELRow = DELline To 2 Step -1
        If wks.Cells(DELRow, "A").Value <> "" Then
          wks.Rows(DELRow).Delete
        End If
      Next DELRow
      If CheckBox17.Value = True Then
        If CheckBox1.Value = False And CheckBox2.Value = False And CheckBox3.Value = False _
        And CheckBox4.Value = False And CheckBox5.Value = False And CheckBox6.Value = False _
        And CheckBox7.Value = False And CheckBox8.Value = False Then
          MsgBox "NENHUMA CONSULTA FOI SELECIONADA." & vbNewLine & vbNewLine & vbNewLine _
          & Space(12) & "SELECIONE UMA CONSULTA."
          CheckBox17.Value = False
          Exit Sub
        Else
          Copiar_ListBox_Folha wks.Range("A1"), Me.ListBox3
          UserForm1_GRAFICO.Show
        End If
      Else
        CheckBox17.Value = False
      End If
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:02
    quinta-feira, 16 de janeiro de 2014 22:34
    Moderador
  • Boa tarde, Felipe.

    Qualquer coisa não funciona bem e não descortino o que é.

    Quanto à sua rotina, penso que funciona bem, depois das correções que gentilmente efetuou, mas a rotina dá-me erro na linha

          UserForm1_GRAFICO.Show

    e como tal, não consigo testá-lo por completo.

    Penso que este erro advém do código inserido no "Initialize" deste Formulário, que gera o gráfico e o coloca no formulário.

    Porém este gráfico é um gráfico criado na folha4, que apenas se altera, modificando os dados inseridos, não é um gráfico criado pelo VBA. 

    Acontece que ao eliminar as linhas, até à linha 2 ou 3, o gráfico também é eliminado e daí poderá também resultar este erro.

    O código associado ao formulário que exibe o gráfico é o que mostro em seguida:

    Private Sub UserForm_Initialize()
    
    Dim ArqImagem As String
    Dim ws As Worksheet
    Dim rng As Range
    Dim GraficoCirc As Chart
    
    Set ws = ThisWorkbook.Sheets("Folha4")
    Set rng = ws.Range("A1").CurrentRegion
    
    Set GraficoCirc = ws.ChartObjects(1).Chart
    
        GraficoCirc.Parent.Width = UserForm1_GRAFICO.Image1.Width
        GraficoCirc.Parent.Height = UserForm1_GRAFICO.Image1.Height
        On Error Resume Next
        
    ArqImagem = ThisWorkbook.Path & "\GraficoCirc.jpg"
    
    GraficoCirc.Export Filename:=ArqImagem, filtername:="JPG"
    
    'carrega grágico
    Image1.Picture = LoadPicture(ArqImagem)
    
    End Sub

    O erro, 

    Run time error '1004':

    Metod 'ChartObjects' of Object '_Worksheet' failed

    O que falta aqui?

    Antes de corrigir o código, o gráfico era corretamente exibido e não desaparecia, porém com a eliminação de linhas o gráfico desaparece.

    Cumprimentos

    M_A_L



    • Editado M_A_S_L sábado, 18 de janeiro de 2014 01:17
    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:02
    sexta-feira, 17 de janeiro de 2014 17:41
  • Bom, acho melhor termos certeza de onde ocorre o erro antes de agir. Tenho duas boas sugestões.

    1 - Depure seu código ao invés de executá-lo. Para tal, pressione a tecla F8 ao invés de F5 no VBE. Dica: se não quiser que a depuração desça num procedimento, pressione Shift+F8. Dessa forma, ele avalia a instrução inteiramente.

    2 - Altere a configuração de seu VBE para interromper os erros dentro de módulos de classe. A saber: formulários são, fundamentalmente, módulos de classe.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sábado, 18 de janeiro de 2014 12:50
    Moderador
  • Felipe.

    Alterei o menu de Opções conforme figura que envia.

    Depurar o código parece complicado, pois o F8 não sai do mesmo ciclo e não percorre as rotinas do formulário principal, no entanto, o único erro que ocorre é na linha que chama o formulário que vai exibir o gráfico.

    No código do formulário gráfico, o F8 aponta o erro.

    Run time error 424 

    Object Required

       

    nesta linha:

    GraficoCirc.Parent.Width = UserForm1_GRAFICO.Image1.Width

    que está incluída neste código. Tentei adaptar as instruções de uma macro que gravei a executar o gráfico e que têm que ser alteradas, pois caso contrário os ranges seriam sempre os mesmos e eu pretendo que eles variem. Se as linhas de dados forem até 12, o gráfico utilizará o range A1 até B7 ... B12, conforme a última linha que tiver dados. Se as linhas de dados contiverem valores, por exemplo até A50, só serão utilizados os dados no range A1:B12.

    O código que tento fazer funcionar e este:

    Dim wks As Worksheet Dim DELline As Long, DELrow As Long Set wks = ThisWorkbook.Sheets("Folha4") DELline = wks.Cells(wks.Cells.Rows.Count, 1).End(xlUp).Row 'Laços para apurar última linha devem ser do fim ao início If wks.Cells(DELline, "A").Value <= 12 Then For DELrow = DELline To 1 Step -1

    Set GraficoCirc = wks.ChartObjects(1).Chart

    ActiveSheet.Range("A1:DELrow, B").Select ActiveSheet.Shapes.AddChart.Select ActiveChart.ChartType = xl3DPieExploded ActiveChart.SetSourceData Source:=Range("Folha4!$A$1:$B$DELrow") ActiveSheet.Shapes("Gráfico 2").IncrementLeft -170 ActiveSheet.Shapes("Gráfico 2").IncrementTop -55 ActiveChart.SeriesCollection(1).Select ActiveChart.SeriesCollection(1).HasTitle = True ActiveChart.SeriesCollection(1).ChartTitle.Characters.Text = "Motivos de Consulta Mais Frequentes" ActiveChart.SeriesCollection(1).ApplyDataLabels ActiveChart.SeriesCollection(1).DataLabels.Select Selection.Format.TextFrame2.TextRange.Font.Size = 14 Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue With Selection.Format.TextFrame2.TextRange.Font.Fill .Visible = msoTrue .ForeColor.ObjectThemeColor = msoThemeColorBackground1 .ForeColor.TintAndShade = 0 .ForeColor.Brightness = 0 .Transparency = 0 .Solid End With Selection.Format.TextFrame2.TextRange.Font.Size = 16 ActiveChart.ChartArea.Select Next End If Dim ArqImagem As String GraficoCirc.Parent.Width = UserForm1_GRAFICO.Image1.Width GraficoCirc.Parent.Height = UserForm1_GRAFICO.Image1.Height On Error Resume Next ArqImagem = ThisWorkbook.Path & "\GraficoCirc.jpg" GraficoCirc.Export Filename:=ArqImagem, filtername:="JPG" 'carrega grágico Image1.Picture = LoadPicture(ArqImagem) End Sub

    Parece-me pois que o gráfico não é criado com as instruções que tem o que é estranho pois foi gravada uma macro a executá-lo.

    Cumprimentos

    M_A_L

    sábado, 18 de janeiro de 2014 17:17
  • Felipe.

    Se no Formulário principal eu colocar um apóstrofo na linha que me dá erro, o código executa-se por completo sem qualquer erro, o que prova que o erro está na rotina de criação do gráfico no evento inicialize do formulário gráfico.

    Neste momento, ele cria a superfície do gráfico, mas não executa o gráfico no seu interior, porque as series não devem estar a ser criadas corretamente.

    Cumprimentos

    M_A_L

    domingo, 19 de janeiro de 2014 13:44
  • Bom, está difícil demais analisar o código do gráfico. Você disse uqe o erro está surgindo no processo de criação do gráfico, mas qual é exatamente o comando que você está utilizando para criar o gráfico?

    E vamos acertar tecnicamente os termos: quando você diz criar o gráfico, você está usando um gráfico existente para alterar os intervalos que esse gráfico se refere ou você está criando um novo gráfico do zero?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    domingo, 19 de janeiro de 2014 15:12
    Moderador
  • Boa tarde, Felipe.

    No início, estava a usar um gráfico feito na folha, cujo range se deveria alterar quando os dados passassem para a folha4.

    Acontece que, o gráfico só vai aproveitar os 12 primeiros registos gravados, pois quando passam p/ a folha já foram previamente ordenados por ordem decrescente (> para <).

    Com o gráfico concebido na folha, cada vez que gravo dados novos, que eliminam os anteriores, o gráfico também é eliminado. O gráfico feito na folha utiliza um range A1:B12 e não deveria alterar esse range quando se gravam novos dados.

    Mas, em determinados dados, apenas são copiados para a folh4, 3 linhas de dados o que deveria obrigar o gráfico a reformular o range. Só que me parece que isso não acontece. Quando gravo 20 linhas de dados e depois gravo 11 linhas, o gráfico apenas se constroi com os dois primeiros dados, Range A1:B2.

    Por esse motivo, pensei em construir um gráfico novo, do zero, do tipo xl3DPieExploded cada vez que preciso dele, apagando-o depois ao sair do formulário. Depois de criado na folha, será exportado para uma pasta no formato "JPG" ou "GIF" para ser exibido no formulário "Userform1_GRAFICO".

    Tentei algumas rotinas de criação de gráficos circulares, mas todas têm falhas e como os meus conhecimentos de VBA, são quase nulos, não consigo ultrapassar esses erros.

    Esquecendo as rotinas enviadas antes, esta é a rotina que tento adaptar para a criação do gráfico, mas dá-me erro na linha:

          .SeriesCollection(1).XValues = ActiveSheet.Range("A1", "B & Ulinha") 

    Run-time error '1004':

    Application-defined or object-defined error

    A área do gráfico é criada na folha, mas não cria o gráfico propriamente dito. Será um erro de atribuição do Range?

    Private Sub UserForm_Initialize() 'Criando Gráfico: Dim chtOb As ChartObject Dim GraficoCirc As ChartObject Dim wkst As Worksheet Dim DELline As Long, Ulinha As Variant Set wkst = ThisWorkbook.Sheets("Folha4") DELline = wkst.Range("A" & Rows.Count).End(xlUp).Row Set chtOb = wkst.ChartObjects.Add(170, 20, 450, 270) For Ulinha = 1 To DELline If Ulinha <= 12 Then With chtOb.Chart .ChartType = xl3DPieExploded .SeriesCollection.NewSeries .SeriesCollection(1).XValues = ActiveSheet.Range("A1", "B & Ulinha") .SeriesCollection(1).Values = ActiveSheet.Range("A1", "B & Ulinha") .SeriesCollection(1).Name = ActiveSheet.Range("12 MOTIVOS MAIS FREQUENTES") End With End If Next

    'Exportar gráfico Dim ArqImagem As String Set GraficoCirc = wks.ChartObjects.Chart GraficoCirc.Parent.Width = UserForm1_GRAFICO.Image1.Width GraficoCirc.Parent.Height = UserForm1_GRAFICO.Image1.Height On Error Resume Next ArqImagem = ThisWorkbook.Path & "\GraficoCirc.jpg" GraficoCirc.Export Filename:=ArqImagem, filtername:="JPG" 'carrega grágico Image1.Picture = LoadPicture(ArqImagem) End Sub

    Cumprimentos

    M_A_L


    • Editado M_A_S_L domingo, 19 de janeiro de 2014 19:11
    domingo, 19 de janeiro de 2014 19:07
  • Boa tarde, Felipe.

    Parcialmente, resolvi o problema. Elabora-me o gráfico, grava a imagem numa pasta com o mesmo caminho da aplicação e exibe no formulário. Saindo do formulário que exibe o gráfico, elimina o gráfico criado.

    No entanto preciso da sua ajuda, na formatação do gráfico.

    Preciso de rodar o gráfico sobre um eixo horizontal cerca de 40º, preciso que o gráfico me exiba os valores da serie no gráfico e preciso de reformular o range utilizado pelo gráfico de forma a que as linhas em branco não sejam consideradas na legenda pois desta forma, como não me permite introduzir ranges em função da última linha preenchida, tive que criar o range A1:A12.

    Se houver apenas 7 linhas preenchidas, as outras 5, saem com cores na legenda e obviamente com a serie em branco.

    Para facilitar, penso eu, deixo-lhe o código a que cheguei.

    Private Sub UserForm_Initialize() 'Criando Gráfico: Dim cht As ChartObject Dim GraficoCirc As ChartObject Dim wkst As Worksheet Dim DELline As Long, Ulinha As Variant Set wkst = ThisWorkbook.Sheets("Folha4") DELline = wkst.Range("A" & Rows.Count).End(xlUp).Row 'For Ulinha = 1 To DELline If DELline <= 12 Then Set cht = wkst.ChartObjects.Add(170, 20, 450, 250) With cht.Chart .ChartType = xl3DPieExploded .SeriesCollection.Add wkst.Range("B1:B12") .SeriesCollection(1).XValues = wkst.Range("A1:A12") .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES" End With End If 'Next

    Dim ArqImagem As String Set GraficoCirc = cht GraficoCirc.Activate ActiveChart.Parent.Width = UserForm1_GRAFICO.Image1.Width ActiveChart.Parent.Height = UserForm1_GRAFICO.Image1.Height On Error Resume Next

    'exporta a imagem do gráfico para a pasta ArqImagem = ThisWorkbook.Path & "\GraficoCirc.JPEG" ActiveChart.Export Filename:=ArqImagem, filtername:="JPEG" 'carrega grágico Image1.Picture = LoadPicture(ArqImagem) 'elimina o gráfico criado cht.Delete End Sub

    O ciclo FOR/NEXT, deveria servir para limitar às linhas preenchidas.

    O código foi testado com a tecla F8 e não apresenta erros.

    Cumprimentos

    M_A_L

    segunda-feira, 20 de janeiro de 2014 17:47
  • Fiz algumaks modificações:

    Private Sub UserForm_Initialize()
      'Criando Gráfico:
      Dim cho As Excel.ChartObject
      Dim GraficoCirc As Excel.ChartObject
      Dim wks As Excel.Worksheet
      Dim lngRow As Long
      Dim lngLast As Long
      
      Set wks = ThisWorkbook.Sheets("Folha4")
      lngRow = wks.Range("A" & Rows.Count).End(xlUp).Row
      Set cho = wks.ChartObjects.Add(170, 20, 450, 250)
      With cho.Chart
        .ChartType = xl3DPieExploded
        .SetSourceData wks.Range("A1:B" & lngLast)
        .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
      End With
      'Next lngrow
      Dim ArqImagem As String
      
      Set GraficoCirc = cho
      GraficoCirc.Activate
      
      ActiveChart.Parent.Width = UserForm1_GRAFICO.Image1.Width
      ActiveChart.Parent.Height = UserForm1_GRAFICO.Image1.Height
      On Error Resume Next
    
      'exporta a imagem do gráfico para a pasta
      ArqImagem = ThisWorkbook.Path & "\GraficoCirc.JPEG"
      ActiveChart.Export Filename:=ArqImagem, filtername:="JPEG"
    
      'carrega grágico
      Image1.Picture = LoadPicture(ArqImagem)
      'elimina o gráfico criado
      
      cho.Delete
      Kill ArqImagem
    End Sub


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:00
    segunda-feira, 20 de janeiro de 2014 21:02
    Moderador
  • Felipe, boa noite.

    Parece que me deparo com um problema de versões do Office. Durante o dia com excel 2013, funcionava. Agora com excel 2010 dá-me erro nesta linha:

    GraficoCirc.Activate

    Vou ver como se porta com a sua rotina e já lhe dou um feed back.

    O que faz o a instrução:

     Kill ArqImagem

    Elimina a imagem armazenada? Se é assim, não é isso que pretendo, pois com o arquivo posso aceder-lhe e dar-lhe outro destino. Apenas pretendo eliminar o que cria na folha, para não serem gerados uma infinidade de graficos.

    Testei a sua rotina e apresenta-me erro na atribuição do range, o mesmo erro que me dava a mim, daí ter alterado para A1:A12 e B1:B12, conforme lhe enviei no último código.

    o erro que dá é:

    Run-time error "1004"
    
    Methode 'Range' of object'_Worksheet' failed.

    Cumprimentos.

    Muito agradecido pela sua paciência e pela partilha de conhecimentos.

    Obrigado.

    M_A_L


    • Editado M_A_S_L segunda-feira, 20 de janeiro de 2014 22:57
    segunda-feira, 20 de janeiro de 2014 22:45
  • Bom dia Felipe.

    Mencionei a ocorrência de um erro na sua rotina. Parece-me ser aqui.

    Dim lngRow As Long
      Dim lngLast As Long
      
      Set wks = ThisWorkbook.Sheets("Folha4")
      lngRow = wks.Range("A" & Rows.Count).End(xlUp).Row
      Set cho = wks.ChartObjects.Add(170, 20, 450, 250)
      With cho.Chart
        .ChartType = xl3DPieExploded
        .SetSourceData wks.Range("A1:B" & lngLast)
        .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
      End With

    A variável lngLast está declarada, mas não atribuída. É correto?

    Substituí lngLast por LngRow e o gráfico apareceu, porém, embora apresente as quantidades, não me apresenta as categorias que são os valores da coluna A.

    Tentei desta forma:

            With cho.Chart
              .ChartType = xl3DPieExploded
              '.SeriesCollection.Add wkst.Range("B1:B" & lngRow)
              .SetSourceData wks.Range("A1:B" & lngRow)
              .SeriesCollection(1).ApplyDataLabels
              .SeriesCollection(1).DataLabels.Select
              Selection.ShowCategoryName = True
              Selection.Format.TextFrame2.TextRange.Font.Size = 14
              Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
              .SeriesCollection(1).XValues = True
              .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
            End With
    

    Mas, sem sucesso, continuam a não aparecer as categorias.

    Dá para resolver?

    Abraços

    M_A_L



    • Editado M_A_S_L terça-feira, 21 de janeiro de 2014 11:49
    terça-feira, 21 de janeiro de 2014 10:36
  • Felipe.

    Depois de muito olhar o código, cheguei a uma conclusão.

    O F8 que me indicou faz efetivamente muita falta e é uma otima ferramenta.

    Com ele desembrulhei o código de forma a que tudo bata certo, exceto a rotação.

    O lngLast faz falta para delimitar o numero de registos pois com o seu código o gráfico executava com todas as categorias. O resto. o F8, disse-me passo a passo, as linhas que deveriam ser eliminadas até chegar ao pretendido.

    E então ficou assim:

    Dim lngLast As Long
    
      Set wks = ThisWorkbook.Sheets("Folha4")
      lngRow = wks.Range("A" & Rows.Count).End(xlUp).Row
      lngLast = wks.Range("B" & Rows.Count).End(xlUp).Row
      Set cho = wks.ChartObjects.Add(170, 20, 500, 290)
      
    lngLast = 10
        If lngRow > 10 Then
    
            With cho.Chart
              .ChartType = xl3DPieExploded
              .SetSourceData wks.Range("A1:B" & lngLast)
              .SeriesCollection(1).ApplyDataLabels Type:=xlValue
              .SeriesCollection(1).DataLabels.Select
              Selection.ShowCategoryName = True
              Selection.Format.TextFrame2.TextRange.Font.Size = 16
              Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
              .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
            End With
        Else
            With cho.Chart
              .ChartType = xl3DPieExploded
              .SetSourceData wks.Range("A1:B" & lngRow)
              .SeriesCollection(1).ApplyDataLabels Type:=xlValue
              .SeriesCollection(1).DataLabels.Select
              Selection.ShowCategoryName = True
              Selection.Format.TextFrame2.TextRange.Font.Size = 16
              Selection.Format.TextFrame2.TextRange.Font.Bold = msoTrue
              .SeriesCollection(1).Name = "MOTIVOS MAIS FREQUENTES"
            End With
        End If
    
    Dim ArqImagem As String

    Se puder ajudar na rotação fico agradecido.

    Se não, fico-lhe agradecido da mesma forma, pois os seus ensinamentos, foram uma mais valia para mim.

    Abraços.

    M_A_L

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 01:00
    terça-feira, 21 de janeiro de 2014 17:52
  • Manuel,

    O que é "rotacionar"?

    Seria isso?

    cho.Chart.PlotBy = xlRows


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    terça-feira, 21 de janeiro de 2014 22:40
    Moderador
  • Felipe.

    Se um gráfico tipo Pie-3D, for visto de cima, veremos um circulo, uma figura geométrica. Mas supondo que existem dois eixos  imaginários, um horizontal e outro vertical, podemos rodar a figura ou sobre o eixo horizontal ou sobre o eixo vertical, dando a ideia de três dimensões no agora evidente polígono geométrico.

    Um gráfico xl3dpieexplosion, essa ideia de 3D, já aparece no gráfico com uma inclinação de 30º, no entanto, para uma melhor visualização nos trabalhos a apresentar, precisava de lhe dar uma inclinação de 50º, pois dessa forma, há melhor visualização dos dados e categorias apresentados no gráfico.

    Gravando o procedimento numa macro, aquilo que preciso, é o correspondente à linha que apresento em seguida, só que por mais voltas que dê, incluindo sites da Microsoft, não consigo a instrução correta para me resolver isto.

        ActiveSheet.Shapes("Gráfico 1").ThreeD.RotationY = 50

    Não sei se a instrução que me envia substitui esta, vou verificar o resultado, pois não conheço a instrução plot. No templo da linguagem Basic, do ZX SPECTRUM, plot correspondia à marcação de um ponto a partir do qual se pretendia por exemplo, iniciar uma linha. A instrução acima, numa macro faz rodar o polígono sobre o eixo Y, 50 graus.

    Penso que e instrução acima vai precisar destas, mas a sintaxe para elas ... Falta-me e não encontro.

    ActiveChart.PlotArea.Select ActiveChart.ChartArea.Select

    É o correspondente a estas instruções tiradas da macro, que me faltam.

    Abraços.

    M_A_L



    • Editado M_A_S_L terça-feira, 21 de janeiro de 2014 23:53
    terça-feira, 21 de janeiro de 2014 23:48
  • Não teste meu exemplo, entendi errado sobre a rotação.

    Bom, por que você não tenta usar algo como:

      wks.Shapes(cho.Name).ThreeD.RotationY = 50
    


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 22 de janeiro de 2014 20:27
    Moderador
  • Bom dia, Felipe.

    Peço desculpa por só agora responder, mas estive ausente. 

    Tentei a instrução que enviou, embora já o tivesse tentado antes, só que atribuía um nome ao gráfico e ele dizia que não encontrava.

    Com a instrução que envia, o gráfico permanece inalterável e fica com a rotação de 15 graus que lhe é atribuida por defeito.

    Cumprimentos

    M_A_L

    quinta-feira, 23 de janeiro de 2014 12:14
  • Essa rotação me pareceu ser mesmo nessa propriedade.

    Dê uma olhada no link http://msdn.microsoft.com/pt-br/library/office/ff822874(v=office.15).aspx

    É isso que deseja fazer?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 23 de janeiro de 2014 22:22
    Moderador
  • Boa noite.

    Penso que será isso, mas aplicado ao objeto gráfico, que não é propriamente uma "shape", mas sim várias e como tal, não consigo aplicá-las ao meu código.

    De uma forma ou de outra, dá-me sempre algum tipo de erro. A sintaxe a utilizar ultrapassa todos os meus escassos conhecimentos de VBA.

    A instrução que enviou anteriormente, não me dá qualquer tipo de erro, pelo que o código se executa de forma correta, porém, não altera o nível de inclinação do gráfico.

    Abraços

    M_A_L

    quinta-feira, 23 de janeiro de 2014 23:05
  • wks.Shapes(cho.Name).Chart.ChartArea.Format.ThreeD.RotationX = -50
    O que acontece nesse caso é que o gravador de macros falha, sendo a sintaxe correta para fazer o ajuste desejado o código acima.

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    • Marcado como Resposta M_A_S_L sábado, 25 de janeiro de 2014 20:06
    sábado, 25 de janeiro de 2014 17:54
    Moderador
  • Felipe, boa noite.

    Você é um anjo.

    À primeira não resultou, fosse qual fosse a posição da instrução.

    Estava a colocar a instrução que me forneceu, na estrutura de criação do gráfico e o gráfico não se alterava.

    Então lembrei-me de colocar a linha de código na parte do código que guarda a imagem como JPG e ...VOILÁ.

    Rodou mesmo e ficou uma maravilha.

    Um agradecimento do tamanho do Brasil.

    Muito obrigado.

    Um abraço

    M_A_L

    sábado, 25 de janeiro de 2014 19:36
  • Não há de quê, grande abraço!

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    domingo, 26 de janeiro de 2014 16:37
    Moderador