ChartObjects(“图表”)。高度创建重复图表

时间:2015-12-15 22:23:20

标签: excel vba excel-vba charts

以下是发生的事情: 1.宏将图表从一张纸复制并粘贴到另一张纸上 2.宏将图表的高度和宽度更改为指定范围 3.宏使用我在代码中其他地方定义的整数

将图表定位在工作表上的某个位置

这是问题所在。当代码执行.Height命令时,Excel会创建一个重复的图表。原始图表保留在原始宽度/高度粘贴的位置,重复图表完全按照预期的方式执行。

为什么命令执行此操作以及如何解决?

    DataRange = "BB"
    NextDataRange = ColIntToText(ColTextToInt(DataRange) + 1)
    n = Worksheets("Labor Data").Range(DataRange & ":" & DataRange).Cells.SpecialCells(xlCellTypeConstants).Count - 1
    DataRange = "'Labor Data'!$" & DataRange & "$3:$" & NextDataRange & "$" & n
    sChtName = "Week vs Blend (Moving Average)"
    LPos = 1
    TPos = 3
    Sheets("Labor Data").Select
    ActiveSheet.Shapes.AddChart2(227, xlLine).Select
    ActiveChart.SetSourceData Source:=Range(DataRange)
    ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Name = sChtName
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartArea.Select
    ActiveChart.ChartTitle.Select
    ActiveChart.ChartTitle.Text = sChtName
    Selection.Format.TextFrame2.TextRange.Characters.Text = sChtName
    With Selection.Format.TextFrame2.TextRange.Characters(1, 10).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 10).Font
        .BaselineOffset = 0
        .Bold = msoFalse
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(89, 89, 89)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 14
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Spacing = 0
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.Parent.Cut
    Sheets("Labor Charts").Select
    ActiveSheet.Paste
    ActiveSheet.ChartObjects(sChtName).Activate

If LPos >= 2 Then LPos = LPos * 7 + 1
If LPos = 1 Then LPos = 8
If LPos = 0 Then LPos = 1


If TPos >= 2 Then TPos = TPos * 15 + 1
If TPos = 1 Then TPos = 16
If TPos = 0 Then TPos = 1

    ActiveSheet.ChartObjects(sChtName).Activate
    ActiveSheet.ChartObjects(sChtName).Height = Range("A1:A15").Height
    ActiveSheet.ChartObjects(sChtName).Width = Range("A1:G1").Width
    ActiveSheet.ChartObjects(sChtName).Left = Cells(1, LPos).Left
    ActiveSheet.ChartObjects(sChtName).Top = Cells(TPos, 1).Top

0 个答案:

没有答案