Question

我有一个宏，可以根据给定的数据绘制图表。在同一个工作簿中，可能还会再绘制几个图表。我想通过使用相同的宏将图表设置到某个位置并使其具有一定的大小。问题是，只有我想实现这一目标的这一行：

ActiveSheet.Shapes("Chart 1").<whatever option goes here>

（如果是下一个图表，则为其他数字）

我想要这样：

ActiveSheet.Shapes("Chart " & x).<option>

我唯一不知道的是每次我打开工作簿以使其正常工作时如何重置x。我有点知道它与workbook_open()以及可能与Public x As Integer有关，但是我不知道如何将其组合在一起。我已经尝试了一些组合，但是没有用。

我的整个代码：

Sub import()


Fname = Application.GetOpenFilename

If Fname = False Then Exit Sub

Sheets("Arkusz2").Select
Columns("A:F").Select
Selection.ClearContents
Selection.ColumnWidth = 8.43

Dim wks As Worksheet

For Each wks In Worksheets
    If wks.ChartObjects.Count > 0 Then
        wks.ChartObjects.Delete
    End If
Next wks





Workbooks.OpenText Filename:= _
    Fname, Origin:=437 _
    , StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=True _
    , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True, DecimalSeparator:=".", ThousandsSeparator:=","


Range("B1").Value = DateValue(Range("B1").Value)

Range("B4, B5, B6, B8").Activate
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False

Range("B21:C100").Select
    Selection.NumberFormat = "0.000E+00"

Range("B2").Select
Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"




Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit


ark = ActiveWorkbook.Name

Columns("A:E").Select
Selection.Copy
Windows("import danych.xlsm").Activate
Sheets("Arkusz2").Select
ActiveSheet.Paste
Range("A1").Select

Windows(ark).Activate
Application.CutCopyMode = False
ActiveWindow.Close savechanges = True
Windows("import danych.xlsm").Activate
Application.CutCopyMode = False

Run "graph"




End Sub

Sub graph()



target = Range("B11").Value
dat = Range("B1").Value

Dim tim As Date
tim = Range("b2").Value
typ = Range("B7").Value

Cells.Find(What:="Ref signaal [A]", After:=ActiveCell, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate


ActiveCell.Offset(1, 0).Select

c = ActiveCell.Row - 1

d = ActiveCell.Value

Do Until d = ""

c = c + 1

ActiveCell.Offset(1, 0).Select
d = ActiveCell.Value

Loop

Cells.Find(What:="Ref signaal [A]", After:=ActiveCell, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, 2).Select

r1 = ActiveCell.Address

ActiveCell.Offset(0, 1).Select

ActiveCell.FormulaR1C1 = "Target"

ActiveCell.Offset(1, 0).Select
r2 = ActiveCell.Address

ActiveCell.FormulaR1C1 = target
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range(r2 & ":F" & c)


Range(r1 & ":F" & c).Select
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
ActiveChart.SetSourceData Source:=Range("Arkusz2!$E$21:$F$" & c)

ActiveChart.FullSeriesCollection(2).Select
With Selection.Format.Line
    .ForeColor.RGB = RGB(255, 0, 0)
End With

ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).ChartType = xlLineMarkers

ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Text = dat & " " & tim & " " & typ

Range("A1").Select
End Sub

Answer 1

也许您应该问自己一个问题，而不是选择（不是按字面意思Select）以数组状顺序索引的各个特定图表，您应该只是遍历所有图表< / strong>，根本不用担心编制索引！

图表有两种类型

图表表

嵌入到各个工作表中的图表。

我想您想在这里处理第二个选项，因为问题中您用ChartX描述的内容可能有多个图表。

现在，理论已不复存在，让我们开始讲究实质吧！

Private Sub loop_through_charts(where as Worksheet) If where.ChartObjects.Count > 0 Then 'if the sheet has Charts Dim cht as ChartObject For Each cht in where.ChartObjects ' do something Next cht End If End Sub

优雅之处在于，我们可以将一个单独的Worksheet传递给该过程，例如。

Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2") loop_through_charts(ws2)

或者甚至将此过程应用于每张纸

Dim ws as Worksheet For Each ws in Thisworkbook.Worksheets loop_through_charts(ws) Next ws

编辑：

因此...在注释中获取更多信息后，只需将以下代码添加到导入过程的底部（一旦绘制了Chart，就可以了）

大概您有变量ws引用了导入按钮中的Worksheet

Dim newestChart As Integer newestChart = ws.ChartObjects.Count With ws.ChartObjects(newestChart) ' do something End With

每次打开工作簿时重置变量

1 个答案: