none
Criar Gráfico de Dispersão em VBA para EXCEL. RRS feed

  • Pergunta

  • Olá Pessoal.

    Como criar gráfico de dispersão em VBA no Excel que tenha: 

    Titulo posicionado a esquerda mas acima do gráfico,
    Legendas posicionadas a direita mas acima do gráfico,
    Titulo no eixo X centralizado na horizontal e abaixo do gráfico,
    Titulo no eixo Y centralizado na vertical a esquerda do gráfico,
    Ancorar o grafico na célula "A40",
    e tenha 1200 px de comprimento e 300 px de altura?

    Abraços,

    silvio pontes


    silvio pontes

    domingo, 26 de fevereiro de 2012 09:09

Respostas

  • Dica:

    Grave macros modificando essas configurações de titulos, legendas e etc...

    Depois vá alterando os parâmetros das macros e adequando as suas necessidades.

    Obs.: Fique atento as propriedades Left,Top,Width e Height pois elas que poderão ser utilizadas na solução do seu problema.

    • Sugerido como Resposta almeida.eas segunda-feira, 19 de março de 2012 17:50
    • Marcado como Resposta Silvio Pontes segunda-feira, 19 de março de 2012 21:18
    domingo, 26 de fevereiro de 2012 13:58

Todas as Respostas

  • Dica:

    Grave macros modificando essas configurações de titulos, legendas e etc...

    Depois vá alterando os parâmetros das macros e adequando as suas necessidades.

    Obs.: Fique atento as propriedades Left,Top,Width e Height pois elas que poderão ser utilizadas na solução do seu problema.

    • Sugerido como Resposta almeida.eas segunda-feira, 19 de março de 2012 17:50
    • Marcado como Resposta Silvio Pontes segunda-feira, 19 de março de 2012 21:18
    domingo, 26 de fevereiro de 2012 13:58
  • Olá Jhonatan, muito obrigado.

    Consegui resolver.

    Vamos registrar para ajudar quem precisar.

    Sub Macro2mm()
        '
        Sheets("生データ").Select 'Seleciona a plan que efetuaremos a proxima acao.
        
        ActiveSheet.Shapes.AddChart.Select 'Adiciona um shape Chart vazio no centro da planilha
        ActiveChart.ChartType = xlXYScatter 'Tipo do Grafico
       
        LastLine = Sheets("生データ").Range("A" & Rows.Count).End(xlUp).Row 'Associa a qtde de dados
        
        Dim MaxScale As Integer
        Dim Aprox As Integer
        
        If (LastLine - 5) / 12 = 0 Then
        MaxScale = (LastLine - 5) * 120
        Else
        MaxScale = (((LastLine - 5) \ 12) + 1) * 120
        End If
           
        Range("U1").Value = LastLine - 5
        Range("U3").Value = MaxScale
            With ActiveChart
            .ChartType = xlXYScatter
            'Set data source range.
            .SetSourceData Source:=Sheets("生データ").Range("A5:A" & LastLine & ",  B5:B" & LastLine & ",   E5:E" & LastLine & ",   H5:H" & LastLine & ",   K5:K" & LastLine & ",   N5:N" & LastLine & ",   Q5:Q" & LastLine) ', 'PlotBy:=xlRows
            .HasTitle = True
            .ChartTitle.Text = "=生データ!B3"
                 
                'The Parent property is used to set properties ofthe Chart.
                With .Parent
                  .Top = Range("A14").Top
                  .Left = Range("A14").Left
                  .Width = 1070
                  .Height = 350
                  .Name = "Grafico 2μm"
                End With
                     
            .Axes(xlCategory, xlPrimary).Select
            .Axes(xlCategory, xlPrimary).TickLabels.Font.Size = 13
            .Axes(xlCategory, xlPrimary).HasTitle = True
            .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "時間(秒)"
            .Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 14
            .Axes(xlCategory, xlPrimary).MinorUnitIsAuto = True
            .Axes(xlCategory, xlPrimary).MajorUnit = 120
            .Axes(xlCategory, xlPrimary).MinorUnit = 60
            .Axes(xlCategory, xlPrimary).MaximumScale = MaxScale
            .Axes(xlCategory, xlPrimary).HasMajorGridlines = True
            .Axes(xlCategory, xlPrimary).HasMinorGridlines = True
            
            .Axes(xlValue, xlPrimary).Select
            .Axes(xlValue, xlPrimary).HasMajorGridlines = True
            .Axes(xlValue, xlPrimary).HasMinorGridlines = True
            .Axes(xlValue, xlPrimary).TickLabels.Font.Size = 13
            .Axes(xlValue, xlPrimary).HasTitle = True
            .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "微粒子数(個/0.1L/分)"
            .Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 15
            .Legend.IncludeInLayout = False
            .Legend.Select
            Selection.Position = xlTop
                  
            ActiveSheet.Shapes("Grafico 2μm").ScaleWidth 1, msoFalse, _
                msoScaleFromTopLeft
                
            ActiveChart.ChartTitle.Select
            Selection.Left = 55
            Selection.Top = 4
            Selection.Format.TextFrame2.TextRange.Font.Size = 18
            ActiveChart.Legend.Select
            Selection.Left = 670
            Selection.Top = 4
            
                With Selection.Format.Line
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorAccent1
                    .ForeColor.TintAndShade = 0
                    .ForeColor.Brightness = 0
                End With
            
            Selection.Format.TextFrame2.TextRange.Font.Size = 14
            
            ActiveChart.PlotArea.Select
            Selection.Top = 22
            Selection.Left = 20
            Selection.Height = 310
            Selection.Width = 1050
              
            End With
    End Sub
    

    Abraços,

    silvio pontes


    silvio pontes

    quinta-feira, 1 de março de 2012 01:11