Как мне сместить все графики в одном листе в VBA? - PullRequest
Новая
       8

Как мне сместить все графики в одном листе в VBA?

0 голосов
/ 24 марта 2020

В настоящее время все мои диаграммы объединены в одном месте на одном листе после выполнения моего кода. Поэтому, чтобы просмотреть их, мне нужно вручную перетащить их в другое место. Так есть ли способ, чтобы я мог разместить все графики в порядке, как показано в ожидаемом результате? Если действительно невозможно сделать что-то подобное, я в порядке смещения графика для каждых 20 ячеек, хотя это и неудобно для просмотра, но все же я пытался сделать это, но не смог сделать это, когда я включил код с текущим выводом с кодом смещения.

Токовый выход (похоже, что есть 1 график, но все графики находятся в одном месте)

enter image description here

Ниже приведен код для моего текущего вывода 

Sub plotgraphs()

'Call meangraph
Call sigmagraph

End Sub
Private Sub sigmagraph()
    Dim i As Long, c As Long
    Dim shp As Shape
    Dim Cht As chart, co As Shape
    Dim rngDB As Range, rngX As Range, rngY As Range

    Dim Srs As Series
    Dim ws As Worksheet

    Set ws = Sheets("Data")

    Set rngDB = ws.Range("A1").CurrentRegion

    Set rngX = rngDB.Columns(1)
    Set rngY = rngDB.Columns(4)

    Do While Application.CountA(rngY) > 0

        Set co = Worksheets("meangraphs").Shapes.AddChart
        Set Cht = co.chart

        With Cht
            .ChartType = xlXYScatter
            'remove any data which might have been
            '  picked up when adding the chart
            Do While .SeriesCollection.Count > 0
                .SeriesCollection(1).Delete
            Loop
            'add the data
            With .SeriesCollection.NewSeries()
                .XValues = rngX.Value
                .Values = rngY.Value
            End With
            'formatting...
            With Cht.Axes(xlValue)
                .MinimumScale = 0
                .MaximumScale = 0.5
                .TickLabels.NumberFormat = "0.00E+00"
            End With
            Cht.Axes(xlCategory, xlPrimary).HasTitle = True
            Cht.Axes(xlValue, xlPrimary).HasTitle = True
        End With

        Set rngY = rngY.Offset(0, 2) 'next y values

    Loop

Код для диаграммы смещения для каждых 20 ячеек (не удалось это сделать) 

 Dim OutSht As Worksheet
'
   Dim PlaceInRange As Range

    Set OutSht = ActiveWorkbook.Sheets("sigmagraphs") '<~~ Output sheet
   Set PlaceInRange = OutSht.Range("B2:J21")        '<~~ Output location
'


'    To place charts at a distance between them
    For Each chart In Sheets("sigmagraphs").ChartObjects
'        OutSht.Paste PlaceInRange
'        Code below changes the range itself to something 20 rows below
        Set PlaceInRange = PlaceInRange.Offset(20, 0)
   Next chart

Ожидаемый результат

enter image description here

1 Ответ

1 голос
/ 24 марта 2020

То, что вы ищете, это свойства .Left и .Top формы, содержащей диаграмму.

Например, макрос, который установит ваши диаграммы в сетку из 2 столбцов, будет выглядеть так: 

Sub SetupChartsIntoGrid()

    Const TopAnchor As Long = 50
    Const LeftAnchor As Long = 50
    Const HorizontalSpacing As Long = 10
    Const VerticalSpacing As Long = 10
    Const ChartHeight As Long = 211
    Const ChartWidth As Long = 360

    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoChart Then
            Dim Counter As Long
            Counter = Counter + 1
            With shp
                .Top = TopAnchor + (WorksheetFunction.RoundUp(Counter / 2, 0) - 1) * (VerticalSpacing + ChartHeight)
                .Left = LeftAnchor + ((Counter + 1) Mod 2) * (HorizontalSpacing + ChartWidth)
            End With
        End If
    Next

End Sub
...