Создайте стили графа Excel из таблицы поиска - PullRequest
0 голосов
/ 17 марта 2020

Я пытаюсь применить согласованные стили графа на основе значения в поле. У меня есть 12 наборов чисел и символов RGB, я хочу применить их к серии графиков с тем же именем.

Я почти на месте, когда я захожу в код в отладчике, он работает, но когда я запускаю полный макрос, стилизация - это просто стили Excel по умолчанию. Благодарен за любые идеи, чтобы выполнить задачу одним ударом?

Вот мой код:

Sub GraphStyles()

' Appy consistent graph styles for LTC Design Elements
' Macro created by Dan Brenton 20200313

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim strRef, strRange As String
    Dim iRow, iCount, iStart, iEnd, iCollection, Col, CountCol, Style, DesEl, Marker, Red, Green, Blue, DEdata As Integer
    Set wb = ThisWorkbook
    For Each ws In wb.Worksheets
        If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
            ws.Name = Replace(ws.Name, " ", "")
            ws.Name = Replace(ws.Name, "(Blank)", "NoGEOLCode")
            ws.Activate
            iRow = 62
            iStart = 62
            iCollection = 1
            Col = 1
            Style = 39
            DesEl = 15
            Marker = 16
            DEdata = 4

            'Select the existing chart, count and remove all series
            ActiveSheet.ChartObjects("Chart14").Activate
            CountCol = ActiveChart.SeriesCollection.Count

            For Col = 1 To CountCol

                ActiveChart.FullSeriesCollection(1).Delete

            Next Col

            'Add series per design element

            Do While ws.Cells(iRow, 2) <> ""
                If ws.Cells(iRow, 4) <> ws.Cells(iRow + 1, 4) Then
                    iEnd = iRow
                    ActiveSheet.ChartObjects("Chart14").Activate
                    ActiveChart.SeriesCollection.NewSeries
                    ActiveChart.FullSeriesCollection(iCollection).Name = "=" & ws.Name & "!$D$" & iStart
                    ActiveChart.FullSeriesCollection(iCollection).XValues = "=" & ws.Name & "!$N$" & iStart & ":$N$" & iEnd
                    ActiveChart.FullSeriesCollection(iCollection).Values = "=" & ws.Name & "!$G$" & iStart & ":$G$" & iEnd

                        ' Apply design element styling (This works when stepped through the debugger but not when whole macro runs?!
                        Do While ws.Cells(Style, DesEl) <> ""

                        If ws.Cells(Style, DesEl) = ws.Cells(iStart, DEdata) Then
                        Red = Cells(Style, 18).Value
                        Green = Cells(Style, 19).Value
                        Blue = Cells(Style, 20)
                        ActiveSheet.ChartObjects("Chart14").Activate
                        ActiveChart.FullSeriesCollection(iCollection).Select
                        With Selection
                            .MarkerStyle = Cells(Style, Marker)
                            .MarkerSize = 5
                            .Format.Line.ForeColor.RGB = RGB(Red, Green, Blue)
                            .Format.Fill.ForeColor.RGB = RGB(Red, Green, Blue)
                            .Format.Fill.Solid
                        End With
                        End If
                        Style = Style + 1

                        Loop

                    iStart = iRow + 1
                    iCollection = iCollection + 1
                End If
                iRow = iRow + 1
            Loop


        End If
    Next

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Вот предварительный просмотр данных для контекста. Таблица поиска стилей в строке 39 и необработанные данные из строки 62 связаны данными в столбцах 4 и 15. enter image description here

1 Ответ

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

Так что я в конце концов понял это и разместил здесь для справки других.

    Sub GraphStyles()

' Appy consistent graph styles for LTC Design Elements
' Macro created by Dan Brenton 20200313

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim strRef, strRange As String
    Dim iRow, iCount, iStart, iEnd, iCollection, Col, CountCol, Style, DesEl, Marker, Red, Green, Blue, DEdata As Integer
    Set wb = ThisWorkbook
    For Each ws In wb.Worksheets
        If UCase(ws.Name) <> "TEMPLATE" And ws.Visible = True Then
            'Change ws names so as not to crash macro
            ws.Name = Replace(ws.Name, " ", "")
            ws.Name = Replace(ws.Name, "(Blank)", "NoGEOLCode")
            ws.Activate
            'Initialise variables
            iRow = 62
            iStart = 62
            iCollection = 1
            Col = 1
            Style = 39
            DesEl = 15
            Marker = 16
            DEdata = 4

            'Select the existing chart, count and remove all series
            ActiveSheet.ChartObjects("Chart14").Activate
            CountCol = ActiveChart.SeriesCollection.Count
            For Col = 1 To CountCol
                ActiveChart.FullSeriesCollection(1).Delete
            Next Col

            'Add series per design element
            Do While ws.Cells(iRow, 2) <> ""
                If ws.Cells(iRow, 4) <> ws.Cells(iRow + 1, 4) Then
                    iEnd = iRow
                    ActiveSheet.ChartObjects("Chart14").Activate
                    ActiveChart.SeriesCollection.NewSeries
                    ActiveChart.FullSeriesCollection(iCollection).Name = "=" & ws.Name & "!$D$" & iStart
                    ActiveChart.FullSeriesCollection(iCollection).XValues = "=" & ws.Name & "!$N$" & iStart & ":$N$" & iEnd
                    ActiveChart.FullSeriesCollection(iCollection).Values = "=" & ws.Name & "!$G$" & iStart & ":$G$" & iEnd

                        ' Loop through lookup table to find design element styling
                        Do While ws.Cells(Style, DesEl) <> ""
                        If ws.Cells(Style, DesEl) = ws.Cells(iStart, DEdata) Then

                        'Assign RGB numbers to variables based on relevant Design Element
                        Red = Cells(Style, 18).Value
                        Green = Cells(Style, 19).Value
                        Blue = Cells(Style, 20)
                        ActiveSheet.ChartObjects("Chart14").Activate
                        ActiveChart.FullSeriesCollection(iCollection).Select

                        'Format marker style, size and fill
                        With Selection
                            .MarkerStyle = Cells(Style, Marker)
                            .MarkerSize = 5
                            .Format.Fill.ForeColor.RGB = RGB(Red, Green, Blue)
                        End With

                        'Format marker border separately to avoid issues with code
                        With Selection.Format.Line
                            .Visible = msoFalse
                            .ForeColor.RGB = RGB(Red, Green, Blue)
                            .Transparency = 0
                        End With
                        End If
                        Style = Style + 1
                        Loop

                    'Reset style to top of lookup table
                    Style = 39
                    iStart = iRow + 1
                    iCollection = iCollection + 1
                End If
                iRow = iRow + 1
            Loop


        End If
    Next

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub
...