Link to home
Start Free TrialLog in
Avatar of ocaccy
ocaccyFlag for Japan

asked on

VBA - Excel 2010 - Becoming a code more efficient & objective.

Hello everyone.

How to becoming this code PURE VBA?

Sub Macro_A31x()

    Sheets("april").Select
    Range("A31:G32").Select
    ActiveSheet.Shapes.AddChar<wbr ></wbr>t.Select
    ActiveChart.SetSourceData Source:=Range("april!$A$3<wbr ></wbr>1:$G$32")
    
     With ActiveChart
        .ChartType = xlLineMarkers
        .HasTitle = True
        .ChartTitle.Text = "=april!A29"
      With .Parent
              .Top = 350 'Range("A34").Top
              .Left = 2 ' Range("A34").Left
              .Width = 263
              .Height = 170
              .Name = "Grafico 2A31x"
     End With
       
    .Axes(xlCategory, xlPrimary).Select
    .Axes(xlCategory, xlPrimary).TickLabels.Font<wbr ></wbr>.Size = 9.6
    .Axes(xlCategory, xlPrimary).HasTitle = True
    .Axes(xlCategory, xlPrimary).AxisTitle.Chara<wbr ></wbr>cters.Text<wbr ></wbr> = "Case"
    .Axes(xlCategory, xlPrimary).AxisTitle.Font.<wbr ></wbr>Size = 8
    ActiveChart.Axes(xlCategor<wbr ></wbr>y).Select
    Selection.TickLabelPositio<wbr ></wbr>n = xlLow
    
    .Axes(xlValue, xlPrimary).Select
    .Axes(xlValue, xlPrimary).TickLabels.Font<wbr ></wbr>.Size = 8
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Chara<wbr ></wbr>cters.Text<wbr ></wbr> = "april"
    .Axes(xlValue, xlPrimary).AxisTitle.Font.<wbr ></wbr>Size = 8
    .Legend.IncludeInLayout = False
    .Legend.Left = 0
    .Legend.Select
    
    Selection.Position = xlCorner
        
    ActiveSheet.ChartObjects("<wbr ></wbr>Grafico 2A31x").Activate
    ActiveChart.Axes(xlValue).<wbr ></wbr>Select
    Selection.MinorTickMark = xlInside

            
    ActiveChart.ChartTitle.Sel<wbr ></wbr>ect
    Selection.Left = -15
    Selection.Top = -15
    Selection.Format.TextFrame<wbr ></wbr>2.TextRang<wbr ></wbr>e.Font.Siz<wbr ></wbr>e = 9.6
    ActiveChart.Legend.Select
    Selection.Left = 230
    Selection.Top = -2
   
    ActiveChart.Legend.LegendE<wbr ></wbr>ntries(1).<wbr ></wbr>Select
    Selection.Format.TextFrame<wbr ></wbr>2.TextRang<wbr ></wbr>e.Font.Siz<wbr ></wbr>e = 8
    ActiveChart.Legend.LegendE<wbr ></wbr>ntries(2).<wbr ></wbr>Select
    Selection.Format.TextFrame<wbr ></wbr>2.TextRang<wbr ></wbr>e.Font.Siz<wbr ></wbr>e = 8

    ActiveChart.SeriesCollecti<wbr ></wbr>on(1).Sele<wbr ></wbr>ct
    
    End With
     
    Dim n As Integer
        With ActiveSheet.ChartObjects("<wbr ></wbr>Grafico 2A31x").Chart
        For n = 1 To 2
            With .SeriesCollection(n)
                .MarkerStyle = Choose(n, 1, 3, 8)

                .MarkerSize = 8
                With .Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColo<wbr ></wbr>r = msoThemeColorBackground1
                    .ForeColor.RGB = RGB(255, 255, 255)
                    .ForeColor.TintAndShade = 0
                End With
                .Format.Line.Visible = msoTrue
                .Format.Line.Weight = 1
            End With
            Next
        End With
        
    ActiveChart.SeriesCollecti<wbr ></wbr>on(1).Sele<wbr ></wbr>ct
    With Selection
        .MarkerStyle = 1
        End With
    Selection.MarkerStyle = 1
    
    ActiveChart.Legend.Select
    ActiveChart.Legend.LegendE<wbr ></wbr>ntries(1).<wbr ></wbr>Select
    ActiveChart.SeriesCollecti<wbr ></wbr>on(1).Sele<wbr ></wbr>ct
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(112, 48, 160)
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(112, 48, 160)
        .Transparency = 0
    End With

    ActiveChart.Legend.LegendE<wbr ></wbr>ntries(1).<wbr ></wbr>Select
    ActiveChart.SeriesCollecti<wbr ></wbr>on(2).Sele<wbr ></wbr>ct
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
    End With
    
    ActiveChart.Legend.Select
    Selection.Position = xlTop
    Selection.Left = 55
    Selection.Top = 9
    ActiveChart.ChartTitle.Sel<wbr ></wbr>ect
    ActiveChart.Axes(xlValue).<wbr ></wbr>AxisTitle.<wbr ></wbr>Select
    Selection.Left = -10
    Selection.Top = 38
    ActiveChart.Axes(xlCategor<wbr ></wbr>y).AxisTit<wbr ></wbr>le.Select
    Selection.Left = 120
    Selection.Top = 160
    ActiveChart.PlotArea.Selec<wbr ></wbr>t
    Selection.Height = 160
    Selection.Width = 240
    Selection.Top = 25
    Selection.Left = 10
        
            
End Sub

Open in new window


Thank you in advance for your attention to this matter.
ocaccy
Avatar of ramrom
ramrom
Flag of United States of America image

'm not sure what you want. The code IS VBA.
ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of ocaccy

ASKER

Forgive me the delay.
I had to clean the code because is very long; the new code is below.
It was good, but still need some things, for example:
I need black border in the PlotArea and the scales in top, not in bottom.
See the pictures, please.
User generated imageUser generated image

Sub VBA_Create_Chart()
' Create Chart with Pure VBA
      
 Sheets(1).Select
 Dim myChart As ChartObject
 Set myChart = ActiveSheet.ChartObjects.Add(Left:=2, Width:=263, Top:=350, Height:=170)
 myChart.Chart.SetSourceData Source:=Sheets(1).Range("A31:G32")
 myChart.Chart.ChartType = xlLineMarkers
 myChart.Chart.HasTitle = True
 myChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Font.Size = 9.6
 myChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Font.Name = "Tahoma"
 myChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Font.NameFarEast = "Tahoma"
 myChart.Chart.ChartTitle.Format.TextFrame2.TextRange.Font.Bold = msoTrue
 myChart.Chart.ChartTitle.Characters.Text = Sheets(1).Range("A29")
 myChart.Chart.ChartTitle.Left = -3
 myChart.Chart.ChartTitle.Top = -15
 myChart.Chart.Parent.Name = "Chart XS"
 myChart.Chart.Axes(xlCategory, xlPrimary).TickLabels.Font.Size = 8
 myChart.Chart.Axes(xlCategory, xlPrimary).TickLabels.Font.Name = "Tahoma"
 myChart.Chart.Axes(xlCategory, xlPrimary).TickLabels.Font.Bold = msoTrue
 myChart.Chart.Axes(xlCategory, xlPrimary).HasTitle = True
 myChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Case"
 myChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 8
 myChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Name = "Tahoma"
 myChart.Chart.Axes(xlCategory, xlPrimary).AxisTitle.Font.Bold = msoTrue
 myChart.Chart.Axes(xlCategory).TickLabelPosition = xlLow
 myChart.Chart.Axes(xlCategory).AxisTitle.Left = 128
 myChart.Chart.Axes(xlCategory).AxisTitle.Top = 155
 myChart.Chart.Axes(xlValue, xlPrimary).TickLabels.Font.Size = 8
 myChart.Chart.Axes(xlValue, xlPrimary).TickLabels.Font.Name = "Tahoma"
 myChart.Chart.Axes(xlValue, xlPrimary).TickLabels.Font.Bold = msoTrue
 myChart.Chart.Axes(xlValue, xlPrimary).HasTitle = True
 myChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Taxi"
 myChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 8
 myChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Font.Name = "Tahoma"
 myChart.Chart.Axes(xlValue, xlPrimary).AxisTitle.Font.Bold = msoTrue
 myChart.Chart.Axes(xlValue).MinorTickMark = xlInside
 myChart.Chart.Axes(xlValue).AxisTitle.Left = -5
 myChart.Chart.Axes(xlValue).AxisTitle.Top = 38
 myChart.Chart.Legend.IncludeInLayout = False
 myChart.Chart.Legend.Left = 190
 myChart.Chart.Legend.Top = -2
 myChart.Chart.Legend.Format.TextFrame2.TextRange.Font.Size = 8
 myChart.Chart.Legend.Format.TextFrame2.TextRange.Font.Name = "Tahoma"
 myChart.Chart.Legend.Format.TextFrame2.TextRange.Font.NameFarEast = "Tahoma"
 myChart.Chart.Legend.Format.TextFrame2.TextRange.Font.Bold = msoTrue
 myChart.Chart.Legend.LegendEntries(2).Select
 myChart.Chart.Legend.Height = 20
 myChart.Chart.PlotArea.Top = 15
 myChart.Chart.PlotArea.Left = 10
 myChart.Chart.PlotArea.Height = 143
 myChart.Chart.PlotArea.Width = 240
 myChart.Chart.SeriesCollection(1).MarkerStyle = 1
 myChart.Chart.SeriesCollection(1).Format.Line.Visible = msoTrue
 myChart.Chart.SeriesCollection(1).Format.Line.ForeColor.RGB = RGB(112, 48, 160)
 myChart.Chart.SeriesCollection(2).MarkerStyle = 3
 myChart.Chart.SeriesCollection(2).Format.Line.Visible = msoTrue
 myChart.Chart.SeriesCollection(2).Format.Line.ForeColor.RGB = RGB(255, 0, 0)

  Dim n As Integer
        With ActiveSheet.ChartObjects("Chart XS").Chart
        For n = 1 To 2
            With .SeriesCollection(n)
                .MarkerStyle = Choose(n, 1, 3, 8)
                .MarkerSize = 8
                With .Format.Fill
                    .Visible = msoTrue
                    .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                    .ForeColor.RGB = RGB(255, 255, 255)
                    .ForeColor.TintAndShade = 0
                End With
                .Format.Line.Visible = msoTrue
                .Format.Line.Weight = 1
            End With
            Next
        End With
 End Sub

Open in new window

Avatar of ocaccy

ASKER

Thank you for your help GrahanSkan.

Now I'm able to put the black border on the plotArea.

 myChart.Chart.Axes(xlValue).MajorTickMark = xlInside
 myChart.Chart.Axes(xlValue).MinorTickMark = xlInside
 myChart.Chart.Axes(xlValue).Format.Line.ForeColor.RGB = RGB(0, 0, 0)
 myChart.Chart.Axes(xlCategory).Format.Line.ForeColor.RGB = RGB(0, 0, 0)

The next step will be, put the scale at the top and keep the text in the footer.

ocaccy
Avatar of ocaccy

ASKER

The problem with the scale in the top is over!
I did not know.
When all the numbers of a range are negative, the scale is at the top as I wanted.
Now I need to know to be possible to reduce the code that sent, without losing funcionality.

Thanks in advance,
ocaccy
Avatar of ocaccy

ASKER

Thank you.

ocaccy