Есть ли способ вставить и отредактировать диаграмму географической карты в макрос Excel?

#excel #vba

#excel #vba

Вопрос:

Я хочу, чтобы данные, которые я извлекаю, вставляли карту штата на уровне округа, а также добавляли соответствующий заголовок и изменяли интервалы расхождения на панели инструментов форматирования рядов данных внутри диаграммы.

Я записал процесс, и код вставит карту состояния, но не внесет нужные мне изменения.

Мои заголовки данных: соотношение штатов и округов.

Вот код, который я записал:

 Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWindow.SmallScroll Down:=-90
ActiveSheet.Shapes.AddChart2(494, xlRegionMap).Select
ActiveSheet.ChartObjects("Chart 8").Activate

ActiveChart.PlotArea.Select
ActiveChart.ChartTitle.Select
Selection.Caption = "NCAT LR by County"
ActiveChart.FullSeriesCollection(1).Select
ActiveChart.FullSeriesCollection(1).SeriesColorGradientStyle = _
    xlSeriesColorGradientStyleDiverging
ActiveChart.FullSeriesCollection(1).SeriesColorMinGradientStop. _
    StopPositionType = xlGradientStopPositionTypeNumber
ActiveChart.FullSeriesCollection(1).SeriesColorMinGradientStop.StopValue = _
    "-0.102"
ActiveChart.FullSeriesCollection(1).SeriesColorMidGradientStop. _
    StopPositionType = xlGradientStopPositionTypeNumber
ActiveChart.FullSeriesCollection(1).SeriesColorMidGradientStop.StopValue = _
    "0.81"
ActiveChart.FullSeriesCollection(1).SeriesColorMaxGradientStop. _
    StopPositionType = xlGradientStopPositionTypeNumber
ActiveChart.FullSeriesCollection(1).SeriesColorMaxGradientStop.StopValue = _
    "1.721"
With ActiveChart.FullSeriesCollection(1)
    .SeriesColorMinGradientStop.StopColor.RGB = 5287936
    .SeriesColorMinGradientStop.StopColor.TintAndShade = 0
    .SeriesColorMinGradientStop.StopColor.Transparency = 0
End With
With ActiveChart.FullSeriesCollection(1)
    .SeriesColorMidGradientStop.StopColor.ObjectThemeColor = 2
    .SeriesColorMidGradientStop.StopColor.TintAndShade = 0
    .SeriesColorMidGradientStop.StopColor.Transparency = 0
End With
With ActiveChart.FullSeriesCollection(1)
    .SeriesColorMaxGradientStop.StopColor.RGB = 255
    .SeriesColorMaxGradientStop.StopColor.TintAndShade = 0
    .SeriesColorMaxGradientStop.StopColor.Transparency = 0
End With
ActiveChart.FullSeriesCollection(1).SeriesColorMinGradientStop.StopValue = "0"
ActiveChart.FullSeriesCollection(1).SeriesColorMidGradientStop.StopValue = _
    "0.50"
ActiveChart.FullSeriesCollection(1).SeriesColorMaxGradientStop.StopValue = "1"
Application.CommandBars("Format Object").Visible = False

 

Похоже, что первая ошибка возникает там, где написано «ActiveSheet.ChartObjects («Диаграмма 8″).Активировать» и сообщение об ошибке:

«Ошибка времени выполнения ‘-2147024809 (80070057)’

Ответ №1:

Это может приблизить вас:

 Sub Tester()

    Dim cht As Chart, co, ws As Worksheet
    
    Set ws = ActiveSheet
    
    ws.Range("A1").CurrentRegion.Select
    
    Set co = ActiveSheet.Shapes.AddChart2(494, xlRegionMap)
    co.Visible = True

    Set cht = co.Chart 'this is the chart you just created
    
    With cht
        .ChartTitle.Caption = "NCAT LR by County"
        
        With .FullSeriesCollection(1)
            .SeriesColorGradientStyle = xlSeriesColorGradientStyleDiverging
            .SeriesColorMinGradientStop.StopPositionType = xlGradientStopPositionTypeNumber
            .SeriesColorMinGradientStop.StopValue = "-0.102"
            .SeriesColorMidGradientStop.StopPositionType = xlGradientStopPositionTypeNumber
            .SeriesColorMidGradientStop.StopValue = "0.81"
            .SeriesColorMaxGradientStop.StopPositionType = xlGradientStopPositionTypeNumber
            .SeriesColorMaxGradientStop.StopValue = "1.721"
    
            .SeriesColorMinGradientStop.StopColor.RGB = 5287936
            .SeriesColorMinGradientStop.StopColor.TintAndShade = 0
            .SeriesColorMinGradientStop.StopColor.Transparency = 0
            .SeriesColorMidGradientStop.StopColor.ObjectThemeColor = 2
            .SeriesColorMaxGradientStop.StopColor.RGB = 255
            
            .SeriesColorMinGradientStop.StopValue = "0"
            .SeriesColorMidGradientStop.StopValue = "0.50"
            .SeriesColorMaxGradientStop.StopValue = "1"
        End With
    End With
    
    Application.CommandBars("Format Object").Visible = False

End Sub
 

Комментарии:

1. Это сработало отлично, спасибо! Еще один вопрос: будет ли какой-либо синтаксис для автоматического изменения размеров диаграммы карты?

2. Вы можете расположить и изменить размер, используя co.Top/Left/Height/Width свойства

3. Отлично получилось! Большое вам спасибо за вашу помощь.