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

Question

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

Answer 1

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.

Answer 2

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