Question

我是路易斯安那州一家小型石油公司的地质学家。我构成了我们的技术部门，不幸的是我的编码经验非常有限。我过去使用过非常基本的vba编码，但是在日常工作中我没有那么多代码，所以我已经忘记了大部分内容。我最近发现了这个网站，它已成为我的一个很好的资源。我已经能够从以前的问题的回答中收集到一些代码，但我再一次陷入困境。

我的整个宏的目的是从外部数据库中检索石油生产数据，根据所述数据计算某些值，然后创建显示数据某些方面的图表。我有完成前两个目标的代码，但我正在努力使代码自动化图形制作过程。

我的问题是每口井都有不同数量的数据。例如，一个井将生产5年，而下一个井将生产10个。我需要能够创建一个宏来选择单元格中的所有数据，然后绘制该数据。目前，每当我选择要绘制的列时，excel将尝试绘制整个列的图形，而不仅仅是我的数据范围，这会导致极大的图形主要是空白区域。列J需要是X轴，列L需要是Y轴。列J中包含文本和数字，列L只有数字

此外，我希望宏使用工作表名称和我将输入的字符串生成图表的名称。对于生成的所有图表，字符串将是相同的。我希望图表与标记图表一致。

命名过程的一个例子就是这样的

工作表名称

石油下降百分比

以下是我到目前为止生成的代码：

Sub automated_graphs()
'
' automated_graphs Macro
'

'
    Range("L:L,J:J").Select
    Range("J1").Activate
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source:=Range( _
        "'EP Allen 1'!$L:$L,'EP Allen 1'!$J:$J")
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.SeriesCollection(1).Delete
    ActiveChart.SeriesCollection(1).XValues = "='EP Allen 1'!$J:$J"
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = "Worksheet Name here" & Chr(13) & "Oil Production by year"
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Worksheet Name here" & Chr(13) & "Oil Production by year"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 20).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 20).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(21, 22).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(21, 3).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(24, 19).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.SeriesCollection(1).Select
    With Selection.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
        .Solid
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
    End With
End Sub

谢谢，如果我能就任何要点提供任何澄清，请告诉我

Answer 1

这样的事情应该有效

Sub DoChart()

Dim sht As Worksheet
Dim xVals As Range, yVals As Range
Dim co As Shape, cht As Chart, s As Series

    Set sht = ActiveSheet
    Set co = sht.Shapes.AddChart()
    Set cht = co.Chart

    'remove any existing series
    Do While cht.SeriesCollection.Count > 0
        cht.SeriesCollection(1).Delete
    Loop 

    cht.ChartType = xlLineMarkers

    'get the extent of the XValues...
    Set xVals = sht.Range(sht.Range("J2"), sht.Cells(Rows.Count, "J").End(xlUp))
    Set yVals = xVals.Offset(0, 2)

    Set s = cht.SeriesCollection.NewSeries
    s.XValues = xVals
    s.Values = yVals

    With s.Format.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
        .Solid
    End With
    With s.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
    End With

    cht.HasLegend = False

    cht.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
    cht.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Year"

    cht.SetElement (msoElementPrimaryValueAxisTitleRotated)
    cht.Axes(xlValue, xlPrimary).AxisTitle.Text = "Production"

    cht.SetElement (msoElementChartTitleCenteredOverlay)
    With cht.ChartTitle
        .Text = sht.Name & Chr(10) & "Oil Production by year"
        .Characters.Font.Size = 12
    End With

End Sub

Answer 2

蒂姆的代码正在崩溃。我学到了很多东西。 Josiah，因为当我阅读Tim的代码时，你似乎对编程很陌生，我在下面添加了一些你可能从中受益的变化：

Set xVals = sht.Range(sht.Range("J2"), sht.Cells(SHT.Rows.Count, "J").End(xlUp))  
' Added SHT for completeness.

Set yVals = xVals.Offset(0, 2)  
' THE ABOVE LINE WORKS BUT REPLACING WITH THE LINE BELOW MAKES IT MORE ROBUST AS 
' YOU SIMPLY CHANGE "J" to be "X" if the data moves from column J to column X.

Set yVals = intersect(xVals.entirerow, sht.columns("J"))

根据数据范围生成图形

2 个答案: